Probleem met Range en Loop

[Tom1978]

Hey,

Ik ben nog maar net begonnen met VBA en ik zie enkele basisregels over het hoofd denk ik......

Ik probeer een code te schrijven die een over een bepaalde range bv. het nummer 40 invoegt. Deze range is echter variabel. (hier nu 3 rijen maar dit verandert telkens)

Het lukt me om deze rijen te selecteren en te copieren naar beneden, maar dan loop ik vast. De gecopieerde rijen moeten op een aantal vlakken verschillen. (Zie verder)

In het vb hier copieer ik eerst 3 kolommen naar beneden. Het enige verschil is dat in de gecopieerde rijen in de plaats van 50 nu 40 moet komen.
Hoe moet ik dit juist aanpakken?

1. Als de rijen net onder elkaar worden gecopieerd. (geen lege rij)
2. As de rijen onder elkaar worden gecopieerd met een lege rij

Als er meerdere mglkheden zijn, graag ook een vb van een oplossing met CountA op de eerste 3 rijen en deze variabele dan gebruiken om de loop te laten werken op de onderste 3 lijnen.

Met lege rij
0234 SB 50
0234 SB 50
0234 SB 50

0234 SB 40
0234 SB 40
0234 SB 40

Zonder lege rij

0234 SB 50
0234 SB 50
0234 SB 50
0234 SB 40
0234 SB 40
0234 SB 40


Graag de code van sub tot end sub, want ik ben een echte beginner....

Bedankt, Gr. Tom

 

[RvanGalenLast]

Tom,

Kan je een voorbeeld van je bestand plaatsen, dat maakt het vaak inzichtelijker. Mocht je Office 2007 gebruiken plaats dan een bestand voor de versies lager dan 2007.

Groet,
Ronald

 

[Tom1978]

Hey,

Ik heb een voorbeeld toegevoegd....
Mij macro werkt voor een heel groot stuk, maar ik loop op een crutiaal punt op dit ogenblik.

De sheet die ik gebruik (zie tap download) moet omgevormd worden naar een sheet die door SAP in de module accouting opgeladen moet worden. De boeking zoals ze er moet uitzien zie je in tap upload SAP. (LET OP: Ik vraag niet dat je de volledige code schrijft, ik heb zelf al een heel groot deel gevonden) en anders is de lol er ook af

Een boeking bestaat uit een debit en credit zijde. Deze moeten aan elkaar gelijk zijn. Voor debit wordt 40 gebruikt in SAP, voor credit 50.
Bij elke 40 lijn hoort dus een 50 lijn. Deze lijnen zijn bijna identiek voor het grootste deel van de info (ccode, transtype, doctype....). echter voor sommige velden is er een verschil.
(zie file)

Uiteindelijk zit het probleem dus in de blauwe zone (tap 3) ( tot daar werkt mijn macro)
ps. het aantal lijnen verschilt van upload tot upload.

Wat ik wil doen is eerst alle 40 lijnen bij elkaar zetten, en daaronder alle 50 lijnen. (of omgekeerd)

Dus "download" wordt "upload SAP" en ik zit tot wat je ziet in "sheet 3" En voor elke blauwe zone geldt hetzelfde probleem

Gr. Tom

 

[RvanGalenLast]

Tom,

Bijgaand het voorbeeld weer terug. Ik ben er vanuit gegaan dat je alleen de regels hebt met code 50. Als dat niet zo is dan hoor ik dat wel.
Waar ik niet helemaal uitkom is de info die je in kolom I en K hebt staan. Die staat in geen enkele sheet en ik kan ook niet uit de andere sheets opmaken waar je deze info weghaalt. Ik vermoed uit sheet1 laatste kolom.

Groet,

Ronald

 

[Tom1978]

Amai, das echt fantastisch....
Daarmee vergeleken is wat ik had echt lachwekkend.....
Zou je een beetje uitleg kunnen geven bij de regels van jouw code, want ik versta niet goed wat er gebeurt?

Hieronder wat ik had

[PHP]Sub callmacros()
    Call delexsdata
    Call insclmn
    Call Ccode_Dtype_Pstky_GLACC
    Call Insbdgt
    Call Taxc_Cctr
    Call Impord
    Call dupltedata
    Call inshdrs
    Call pstk_cost
   
      
End Sub
Sub delexsdata()
    Range("A:A,C:C,E:E,G:G,H:H,I:I,J:J,K:K,L:L,M:M,N:N,O:O,P:P,Q:Q,R:R,S:S,T:T,V:V").Select
    Selection.Delete
    Range("1:1").Select
    Selection.Delete
    
End Sub
Sub insclmn()
    Dim i As Integer
    For i = 1 To 4
     Columns("A:A").Select
     Selection.Insert Shift:=xlToRight
    Next i
End Sub
Sub Ccode_Dtype_Pstky_GLACC()
    Dim cel As Range
        Range("E1", Range("E56536").End(xlUp)).Select
        For Each cel In Selection
            cel.Offset(0, -4) = "'0234"
            cel.Offset(0, -3) = "SB"
            cel.Offset(0, -2) = "50"
            cel.Offset(0, -1) = "87040"
        Next cel
End Sub
Sub Insbdgt()
    Columns("E:E").Select
        Selection.Insert Shift:=xlToRight
    Columns("I:I").Select
         Selection.Cut
    Columns("E:E").Select
        ActiveSheet.Paste

End Sub
Sub Taxc_Cctr()
     Dim cel As Range
     Dim j As Integer
     For j = 1 To 2
         Columns("F:F").Select
         Selection.Insert Shift:=xlToRight
     Next j
         Range("H1", Range("H56536").End(xlUp)).Select
                 For Each cel In Selection
                    cel.Offset(0, -2) = "Z0"
                    cel.Offset(0, -1) = ""
                 Next cel
End Sub
Sub Impord()
    Range("I:I").Select
        Selection.Insert Shift:=xlToRight
    Range("M:M").Select
        Selection.Cut
    Range("I:I").Select
        ActiveSheet.Paste

End Sub
Sub dupltedata()
    Range("A1", Range("B65536").End(xlUp)).Select
    Selection.Copy
    Range("A65536").End(xlUp).Offset(2, 0).Select
    ActiveSheet.Paste

End Sub
Sub inshdrs()
    Range("A1").Activate
    ActiveCell.EntireRow.Insert
        Range("A1") = "Company Code"
        Range("B1") = "Doc. Type"
        Range("C1") = "Posting key"
        Range("D1") = "G/L account"
        Range("E1") = "Amount"
        Range("F1") = "Tax code"
        Range("G1") = "cctr"
        Range("H1") = "profit center"
        Range("I1") = "Order"
        Range("J1") = "Tekst"
        Range("K1") = "Assignment"
        Range("L1") = "Trading Partner"
        Range("M1") = "Materiaal"
        Range("N1") = "Personeelsnr."
        Range("O1") = "Trans. type"
    Range("A1:O1").Select
    Selection.Interior.ColorIndex = 4
    Cells.Columns.AutoFit
End Sub
Sub pstk_cost()
    Dim r As Integer
    Dim rloop As Integer
        rloop = Excel.WorksheetFunction.CountA(Blad1.Range("C:C"))
         For r = 1 To rloop
          If Cells(r, 3) = "" Then
            Cells(r, 3) = 40
        End If
    Next
 
 End Sub[/PHP]

PS.
Die assignment is de bonnummer met "-" een aantal maal tussen. (customized format cel)
Die andere kolom is de imputatiekolom zonder de "A" ervoor met een ander getal ervoor (8 of 9) en maar 6 karakters lang. Moet ik nog een beetje uitvissen hoe, maar ga ik eerst zelf nog wat op zoeken.


Alvast heel fel bedankt, Tom

 

[RvanGalenLast]

Beste Tom,

Bijgaand het bestand nog een keer met de uitleg bij de code geplaatst. Hetgeen jij al had zou wellicht wat korter kunnen maar daarmee heb je blijkbaar al een deel voorwerk gedaan. Ik ben slechts verder gegaan met de gegevens die jij al had. :thumb:

Succes.

Groet,

Ronald

 

[Tom1978]

Ciao mannekes,

Ik ben nog een beetje bezig geweest met die luskes

Echter ik bots hier toch ook weer op een probleem (bij gebruik van Cstr). Excel blijft hier hangen... Waarom eigenlijk? ik krijg een gele pijl voor next cel.

Sub FORMATEAN()
Dim cel As Range
Range("C:C").Select
Selection.Insert shift:=xlToRight
Range("B:B").Select
For Each cel In Selection
cel.Offset(0, 1) = CStr(cel)
Next cel
End Sub

Als ik dit gebruik werkt het helemaal niet...

Range("E1", Range("E56536").End(xlUp)).Select

Trouwens, nogmaals bedankt voor de uitleg bij de excelsheet !

 

[RvanGalenLast]

Tom,

Ik kan niet herleiden waarom het bij jouw niet werkt. In het bijgaande bestand een voorbeeld hoe het ook kan. Kijk ook eens naar het tweede stukje code. Wellciht is dat ook bruikbaar.

Vwb:

Range("E1", Range("E56536").End(xlUp)).Select

wijzig dit in :

Range("E56536").End(xlUp)).Select

en het werkt wel.

Groet,

Ronald