Just nu i M3-nätverket
Gå till innehåll
mon935

Göra en beräkning i VBA utan att mellanlagra resultat i en cell

Rekommendera Poster

Hejsan!

Jag har en fil med en massa "grundrader" som underlag för en massa beräkningar. Varje sådan grundrad genererar tolv nya beräknade rader. Varje grundrad har ett radnummer som kopieras till de nya raderna. För att öka läsbarheten har jag färglagt alla rader med ett jämt radnummer.

 

Nu till mitt problem. Jag har inte kommit på hur man gör för att slippa "mellanlagra" resultatet av if-satsen i en separat cell (0,34). En 2 eller 1 beroende på om resultatet är sant eller falskt. Hur gör man för att komma förbi detta? 

Så här ser min kod ut idag:

 
Sub BytBakgrundsfärg()
               
        ActiveCell.Offset(0, -32).Select
        ActiveCell.Offset(0, 34).FormulaR1C1 = "=IF(ISEVEN(RC[-33])=TRUE,2,1)"
          
        If ActiveCell.Offset(0, 34).Value = 2 Then
        GoTo Markera
        Else: Exit Sub
        End If
        
Markera:
        ActiveCell.Rows("1:12").EntireRow.Interior.Color = rgbBeige
End Sub

Dela detta inlägg


Länk till inlägg
Dela på andra webbplatser

Ughhh, vilka krånglig hopp du gör

 

En variant är att använda excelfunktionen direkt i VBA med hjälp av WorksheetFunction. Det enda är att du måste fixa till dina cellreferenser på något sätt.

 

 

Sub BytBakgrundsfärg()
ActiveCell.Offset(0, -32).Select

If Application.WorksheetFunction.IsEven(Cells(ActiveCell.Row, ActiveCell.Column + 34 - 33)) Then
       Rows("1:12").Interior.Color = RGB(255, 0, 0)
End If
End Sub

Dela detta inlägg


Länk till inlägg
Dela på andra webbplatser

Usch och fy på er båda!

 

Bort med alla Select och Activecell anrop!

och ta en titt på villkorsstyrd formatering om inte denna funktion räddar dig helt från hiskelig VBA-kod.

 

Förlåt mina hårda ord men det blöder i mina ögon...

Activecell måhända användas för att hitta en referens i början av en loop med därefter ska alla referenser hållas relativa inom koden utan Select-satser.

Sub BytBakgrundsfärg()
Dim myRn as Range
Set myRn = Activecell.Offset(0, -32)
If Application.WorksheetFunction.IsEven(Cells(myRnl.Row, myRn.Column + 34 - 33)) Then
       Rows("1:12").Interior.Color = RGB(255, 0, 0)
End If
End Sub

Lite städat... men inte riktigt bra det ovan heller.

Dela detta inlägg


Länk till inlägg
Dela på andra webbplatser

Usch och fy på er båda!

 

Bort med alla Select och Activecell anrop!

och ta en titt på villkorsstyrd formatering om inte denna funktion räddar dig helt från hiskelig VBA-kod.

 

Förlåt mina hårda ord men det blöder i mina ögon...

Activecell måhända användas för att hitta en referens i början av en loop med därefter ska alla referenser hållas relativa inom koden utan Select-satser.

Sub BytBakgrundsfärg()
Dim myRn as Range
Set myRn = Activecell.Offset(0, -32)
If Application.WorksheetFunction.IsEven(Cells(myRnl.Row, myRn.Column + 34 - 33)) Then
       Rows("1:12").Interior.Color = RGB(255, 0, 0)
End If
End Sub

Lite städat... men inte riktigt bra det ovan heller.

Tack för ditt svar.

Jag är nybörjare i VBA och hade inte koll på WorksheetFunktion. (Ska läsa på mer om den funktionen). Har liksom tänkt att det måste finnas en annan väg att gå än just activecell och select. Det var därför jag lade ut denna fråga. Det är liksom lite svårt, att hitta möjliga kommandon och rätt syntax, när man är nybörjare.

Gillar lösningen med myRn, den ska jag lägga på minnet. Mycket användbart.

 

Din kod ovan funkar bra förutom att Then-satsens  "Rows(1":12")" inte är en relativ referens. Det var rad 1-12 som ändrade färg. Min intention är att färglägga den raden jag står på samt kommande 11 rader (dvs 12 rader tot). Hur skriver man den relativa referensen? (det var det här med syntaxen igen.)

Dela detta inlägg


Länk till inlägg
Dela på andra webbplatser

Fasen vad känslig Monshi är :)

 

Det enklaste är nog att använda Resize(rader, kolumner). Typ:

 

myRn.EntireRow.Resize(12).Interior.Color = RGB(255, 0, 0)

eller, om du tycker att det är mer pedagogiskt att utöka först

myRn.Resize(12).EntireRow.Interior.Color = RGB(255, 0, 0)

 

/M

 

 

Om du har väldigt tråkigt kan du försöka lista ut hur det här kommer att se ut utan att tjuvkika :huh: :

Sub Ruotsi()
Dim myRn As Range
Set myRn = Range("a1")
myRn.Resize(10, 6).Interior.Color = RGB(0, 75, 135)
myRn.Offset(4, 0).Resize(1, 6).Interior.Color = RGB(255, 205, 0)
myRn.Offset(0, 2).Resize(10, 1).Interior.Color = RGB(255, 205, 0)
End Sub

Dela detta inlägg


Länk till inlägg
Dela på andra webbplatser

Skapa ett konto eller logga in för att kommentera

Du måste vara medlem för att kunna kommentera

Skapa ett konto

Skapa ett nytt konto på vårt forum. Det är lätt!

Registrera ett nytt konto

Logga in

Redan medlem? Logga in här.

Logga in nu



  • Liknande Innehåll

    • Av DanneK
      Jag är säker på att detta är möjligt, bara det att jag inte är kapabel att förstå…
      Skall se om jag kan beskriva vad jag är ute efter ordentligt.
      Jag önskar presentera data från ett exeldokument och har en massa härliga formler som gör merparten jobbet åt mig efter att importen från den externa datan i sin tur gjorts.
      Nu till problemet.
      Jag skulle under summeringar och liknade i ”Presentation” vilja loopa ut resultaten som uppfyller ett visst antal villkor och lägga till det som nya rader. Det är okänt antal rader var gång, från 0-ca 150st. Antalet kolumner är kända.
      Datan är samlade i en flik ”Data”
      Dvs…
       
      Jag skulle vilja få fram följande:
       
      Rubrik | Summering1 | Summering2| Summering3| - Löst del.
      Data!Dx | Data!Ex| Data!Fx| Data!Kx
      Data!Dx | Data!Ex| Data!Fx| Data!Kx
      Data!Dx | Data!Ex| Data!Fx| Data!Kx
       
      x för okänd rad som uppfyller tre villkor, Datum from, Datum tom, samt ett fritextvärde, där dessa rader enl. ovan är okänt antal.
      Hitintills har alla försök slutat med kaos, likt de flesta VBA försök jag gör, varvid jag inte ens har någon vettig kod att börja med. Alla tips är välkomna, och det behöver inte vara en VBA-lösning, bara jag som misstänker att det är dit jag skall vända mig.
    • Av MvS
      Hallå i forumet!
      Har tidigare adresserat detta forum angående problem med kopplad utskrift av db till Word och trodde först jag hittat svaret. Men efter månader av petande och sökande i så gott som det mesta som skrivits om mailmerge har jag fortfarande problem, om än ett par nivåer upp i kunskapshierarkin!
       
      Har samplat ihop ett VBA-skript från olika källor och som jag har modellerat om lite efter egna behov (Se bifogad fil "MailMerge.txt") och använder tillsammans med den databas jag skapat i Excel med relativt stort omfång (ca 8100 poster). Med denna vill jag via VBA koppla en etikettutskrift-funktion där ett av tre för-preppade Worddokument (Etiketter1, 2, 3.docm) öppnas med uppdaterad etikett-data beroende på mellan vilka årtal posterna har. Jag har tre perioder där villkoren är: (Före 1994), (Efter 1993 och Före 2013) samt (Efter 2012) som jag har angett två konstanter som får agera brytpunkter (1994 och 2012).
      Har som sagt prövat det mesta men har problem med kopplingen som genererar fel svar (se bif. bild "Dialog1.jpg")!
      Någon som kan se var felet ligger i bifogad kopia av VBA?

       

      MailMergeVBA.txt
    • Av MvS
      Jag har gjort en databas i Excel 2013 åt en kompis för hans stora skivsamling. Jag försöker att skapa ett automatiserat flöde där det enkelt ska gå att skriva ut etiketter ur samlingen att fästa på hyllor och lådor där skivorna förvaras. För detta ändamål har jag skapat tre etikettmallar i Word för olika tidsperioder (Mall 1 = 1950 - 1970. mall 2 = 1970 - 1990, mall 3 = Från 1990) som kan användas att märka upp de många lådor som skivsamlingen finns i.
      Jag har försökt hitta VBA-kod som kan bistå med detta så att man bara behöver klicka på en knapp i Excel-databasen för att automatiskt skapa en etikettserie  i Word (mailmerge). Det verkar funka så långt att Word öppnar och påbörjar mailmerge med sen hänger sig programmet i flera minuter och Word kraschar. 
      Så här ser min kod ut för första tidspannet (1950-1970):
      Private Sub Document_Open() Dim wd As Object Dim wDocSource As Object, wDocPath As String Dim strWorkbookName As String Set wDocSource = ThisDocument wDocPath = ThisDocument.Path strWorkbookName = wDocPath & "\Etiketter+Db.xlsm" On Error Resume Next Set wd = GetObject(, "Word.Application") If wd Is Nothing Then Set wd = CreateObject("Word.Application") End If On Error GoTo 0 wDocSource.MailMerge.OpenDataSource Name:= _ strWorkbookName, _ Connection:="Data Source=" & strWorkbookName & ";Mode=Read", _ SQLStatement:="SELECT * FROM `Db$`" With wDocSource.MailMerge .Destination = wdSendToNewDocument .SuppressBlankLines = True With .DataSource .FirstRecord = wdDefaultFirstRecord .LastRecord = wdDefaultLastRecord End With .Execute Pause:=False End With ActiveDocument.SaveAs2 FileName:= _ wDocPath & "\Etiketter_Pre-1970.docx", _ FileFormat:=wdFormatXMLDocument ChangeFileOpenDirectory _ wDocPath ActiveDocument.SaveAs2 FileName:= _ wDocPath & "\Etiketter_Pre-1970.docx", _ FileFormat:=wdFormatXMLDocument, LockComments:=False, Password:="", _ AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False, _ EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData _ :=False, SaveAsAOCELetter:=False, CompatibilityMode:=15 End Sub Då jag kapar sekvensen efter SQLStatement  (i.e. INNAN begäran om att fullfölja mailmerge) så verkar det gå bra, men då måste man "manuellt" välja "Slutför och koppla" för att etikettserien ska genereras och jag vill att hela processen ska funka automatiskt så att det bara är för användaren att skriva ut! Grunddelen av VBA-koden ovan har jag fått genom en makroinspelning och sedan har jag lagt till delar jag hittat på nätet. En märklig sak dock är att själva filtreringen jag gör underinspelningen i "Redigera mottagarlista" kommer av någon anledning inte med i koden - varför då?
      Jag har också prövat att lägga in "WHERE" argument i SQL-statement efter tips när jag Googlat runt men då hittar inte Word sökvägen till Excel-filen och dokumentet kan inte öppna!
      Känner spontant att detta bara måste funka men antagligen är det något knas med kodningen som ställer till det. Om det finns någon i forumet som har råkat ut för motsvarande och till äventyrs hittat en bra lösning vore jag stort tacksam för hjälp!
       
       
    • Av MvS
      Hej alla Excelkunniga!
      Har ett problem jag inte kan förstå hur det ska lösas. Har gjort en inventeringslista i Excel som jag vill kunna skriva ut etiketter på olika poster. Etiketterna kan ha tre olika symboler (bilder) i sig beroende på om posten skapades före ett visst årtal, mellan två år eller efter ett tredje årtal. Så jag har skapat tre wordmallar som jag vill anropa vid etikettutskrift från min Excelfil. Har snokat runt webben och landat i ett VBA-skript som verkade kunna göra jobbet. Jag har med mina något rudimentära kunskaper i VBA försökt anpassa skriptet att öppna beroende på vad man anger via en  combobox: Före 1994, mellan 1994-2011 samt efter 2011.
      Jag har använt case-anrop för kommandona (se skript nedan) men när jag försöker köra det så öppnar Excel visserligen rätt Worddokument men skriptet stannar sedan och felmeddelande visas:

       
      Har prövat att modda skriptet på olika sätt, googlat efter lösning på problemet men inte lyckats finna vad som fattas. Nu står mitt sista hopp till om någon VBA-kunnig på Eforum kan hjälpa mig.
      Sub Etiketter() Call TaBortSkydd Dim ws As Worksheet Dim Opt As Integer, Result As Action Dim objWord As Object Set ws = ActiveSheet Opt = ws.Range("$O$1").Value Set objWord = CreateObject("Word.Application") objWord.Visible = True Select Case Opt Case Is = 1 Result = objWord.Documents.Open(Application.ActiveWorkbook.Path & "\Etiketter_1.docx") Case Is = 2 Result = objWord.Documents.Open(Application.ActiveWorkbook.Path & "\Etiketter_2.docx") Case Is = 3 Result = objWord.Documents.Open(Application.ActiveWorkbook.Path & "\Etiketter_3.docx") End Select ws.Range("$O$1").ClearContents Call Workbook_RefreshAll Call SkyddaBlad End Sub Med hopp om räddning...
    • Av MvS
      Jag har en matrikel där jag har infogat en tidstämpelfunktion som har funkat hyggligt men nu krånglar. 
      Har prövat lite olika varianter men får vid varje uppdatering upp en dialogruta med "Ogiltigt proceduranrop eller argument". (Se bifogad bild.)
      Det är ett enkelt skript men jag blir inte klok på vad som felas - någon som vet bättre än mig? 
      Bifogar skriptet som txt-fil!
       

      VBA Timestamp.txt
       
      Infogar texten direkt, förenklar kanske lite:
      Private Sub Worksheet_Change(ByVal Target As Range) Call Modul1.TaBortSkydd Application.EnableEvents = False ActiveSheet.ListObjects("Tabell2").Range.Select With Selection If Target.Column <= 13 Or Target.Column >= 15 Then Range("N" & Target.row).Value = Date End If End With Application.EnableEvents = True Call Modul1.Skydd End Sub /Mikael63, moderator
  • Senaste som Tittar

    Inga registrerade medlemmar är inne på denna sida.

  • Obesvarade ämnen

  • Nya ämnen

×
×
  • Skapa nytt...