Jeg er kørt fast i hvordan jeg får indsat en ekstra If eller hvad der er jeg skal have indsat 😒
Har nedestående kode, hvor den kigger på om der står JA eller NEJ i det andet ark(fil) som den skal hente fra. Jeg vil så have den til at springe de linjer over hvor der står Fravælg. Håber der er en der kan sparke mig i den rigtige retning....
så ret fra If src.Worksheets("Kalk").Cells(iCnt, "B") = "JA" Then til If src.Worksheets("Kalk").Cells(iCnt, "B") = "FRAVÆLG" Then ' spring over kode' ElseIf src.Worksheets("Kalk").Cells(iCnt, "B") = "JA" Then
det burde være det hele. Det kan være, at den laver noget for meget, men så indsæt Next iCnt ved 'spring over kode' (det er en grim løsning ikke at slutte loop samme sted)
Der har jeg været, men kunne ikke rigtigt takle den. Når jeg bruger ovenstående med Next iCnt oppe ved If koderne, så melder den fejl. Next whitout For. Det er lige som om at den så glemmer den For længere oppe i koden. Tager lige hele koden med ind her.
' OPEN THE SOURCE EXCEL WORKBOOK IN "READ ONLY MODE". Set src = Workbooks.Open("J:\Standardpriser.xlsm", True, True)
' GET THE TOTAL ROWS FROM THE SOURCE WORKBOOK. Dim iTotalRows As Integer iTotalRows = src.Sheets("Kalk").Range("D1:D" & Cells(Rows.Count, "D").End(xlUp).Row).Rows.Count
' COPY DATA FROM SOURCE (CLOSE WORKGROUP) TO THE DESTINATION WORKBOOK. Dim iCnt As Integer ' COUNTER. For iCnt = 20 To iTotalRows ws1.Cells(iCnt, "A").Value = "Nej"
If src.Worksheets("Kalk").Cells(iCnt, "B") = "JA" Then ws1.Cells(iCnt, "C").Interior.ColorIndex = 6 ws1.Cells(iCnt, "B").Value = "" If src.Worksheets("Kalk").Cells(iCnt, "B") = "Fravælg" Then
Next iCnt ' HER MELDER DEN SÅ FEJL
Else If ws1.Cells(iCnt, "C") = "" Then ws1.Cells(iCnt, "B") = "" ws1.Cells(iCnt, "C").Interior.ColorIndex = 2
den er også gal - du er i en IF, hvor der skal stå JA, og så tester du, om der står FRAVÆLG - det kan jo ikke ske. Fravælg skal have et ydre loop (før der testet på JA/NEJ) så du springer alt koden over. Jeg har taget det originale loop med iCnt, og lagt en linje ind i starten og en linje næstsidst ---------------------- For iCnt = 20 To iTotalRows
If src.Worksheets("Kalk").Cells(iCnt, "B") <> "Fravælg" Then
---------------------- det er reelt en If src.Worksheets("Kalk").Cells(iCnt, "B") <> "Fravælg" Then End If uden om din kode, så Fravælg kun tæller iCnt op, og intet laver der ud over.
Tusind tak for din løsning og ikke mindst forklaringen 👍 Den er lige ved at være der. Har dog et ønske til den og det er at den sætter tomme rækker ind, der hvor der er Fravælg. Er der en rimelig løsning på at den ikke sætter tomme rækker ind, men bare springer videre til den næste Ja eller Nej?
Det var da noget vrøvl jeg fik skrevet. Jeg vil selvfølgelig ikke have at den indsætter rækker, når den møder Fravælg. Kan se at jeg fik skrevet ønsker at den skal indsætte rækker, men det gør den. Jeg vil meget gerne undgå at den gør det 😒
ok, det er lettest med en makro ved siden af. Se fx https://www.absentdata.com/delete-blank-rows/ metode 1 I. Removing Blank Rows with Find & Select 1. Click Find & Select 2. Click to Go to Special 3. Choose Blanks 4. Click OK and then all the blank rows/cells will be highlighted 5. Choose the Delete under Cells section on the Home Tab 6. Click Delete Sheet Rows det kan du optage som makro, og gemme under eget navn - derefter kopierer du selve den dannede kode (undtagen første og sidste linje med Sub) og lægger den ind lige efter Next iCnt så den kører det inden arket låses.
Det kunne helt bestemt være en mulighed. Men problemet er at den i de "tomme" rækker, sætter et nej i kolonne A, samt at der er tomme (afstands) rækker i det overførte materiale. Så det vil ikke du her. Desværre. Det er sgu da også noget besværligt noget jeg kommer frem med....
ok, så er der kun manuel sletning tilbage. Du har beskyttet arket med Worksheets("Standardpriser").Protect så den skal lige ophæves, og derefter kan du markere flere rækker ved at holde Ctrl nede, og så klikke på linjenumre der skal slettes, og derefter slette dem fra arket. Til sidst husk at sætte Worksheets("Standardpriser").Protect til igen.
Takker for din hjælpsomhed 👍 Jeg vil ikke sætte den som løst, da der må findes en automatisk løsning. Jeg vil prøve og lede videre efter en løsning og dukker den op, så kommer den også her.
Synes godt om
1 synes godt om dette
Ny brugerNybegynder
Din løsning...
Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.