Microsoft Excel

Herbers Excel/VBA-Archiv

Bewerten Sie hier bitte das Excel-Portal

Der kurze Weg zum Ziel: Auftragsprogrammierung

Zelle.Address

nach unten

Betrifft: Zelle.Address von: Peter Kordsmeyer
Geschrieben am: 14.09.2020 13:13:13

Hallo allerseits!


Ich habe ein kleines Problem, da komme ich einfach nicht weiter und würde mich über Hilfe freuen!


In den Felder meines Sheets sind folgende Einträge:


B2 = 1000 , C2 = A , D2 = 01.08.2020

B3 = 2000 , C3 = B , D3 = 03.08.2020

B4 = 3000 , C4 = C , D4 = 05.08.2020

B5 = 4000 , C5 = D , D5 = 07.08.2020


Das zugehörige Makro:

Sub Test()

    Zeile = Range("A1")
    For Each Zelle In Range("B2:D5")
        Zeile = Zeile + 1
        Range("F" & Zeile) = Zelle.Address
        Range("G" & Zeile) = Zelle.Value
        Range("A1") = Zeile + 1
    Next Zelle
End Sub

Jetzt das Problem:

Beim ersten Start läuft alles rund. Wenn ich das Makro erneut aufrufe, soll das Ergebnis in den Spalten F und G unten angehängt werden. Allerdings soll die Zelladresse gändert werden. In Feld F1 ist das Ergebnis = $B$2.

Nach dem zweiten Durchlauf soll in Zelle F14 $B$7 erscheinen.

Zum Teil sind auch mehrere Umläufe notwendig, wobei die dann die Zelladressen jeweils geändert werden müssen.

Ja, da komme ich nicht weiter. Dieses ist nur ein kleines Beispiel eines etwas umfangreicheren Programms. Wenn ich hier eine Lösung bekomme, kann ich das auch weiter umsetzen.

Vielen Dank für Eure Hilfe!

Peter

nach oben  nach unten

Betrifft: AW: Zelle.Address
von: ralf_b
Geschrieben am: 14.09.2020 13:43:30

es wird niemals ein Wert $B$7 in geben, da deine schleife nur von zeile 2 bis zeile 5 arbeitet.

deine beschreibung ist ungenau. versuch es bitte nochmal.

nach oben  nach unten

Betrifft: AW: Zelle.Address
von: Peter
Geschrieben am: 14.09.2020 14:04:24

Hallo Ralf,
vielen Dank für die schnelle Antwort.
Im zweiten bzw. weiteren Durchlauf der Schleife wird das Ergebnis ab Zeile 14 - erneut angezeigt, allerdings soll Datei dabei Als Adresse $B$7 usw. angezeigt werden.
Ziel ist, dass das Ergebnis in einem weiteren Schritt ab in den Spalten B C D ab Zeile 7 ergänzt werden.
Im Original sind die Daten natürlich nicht so identisch und ich habe da auch eine Quell- sowie Hilfsdatei.
Ich hoffe, etwas zur Aufklärung beigetragen zu haben.
Danke für Deine Hilfe!
Peter

nach oben  nach unten

Betrifft: AW: Zelle.Address
von: Frank Svoboda
Geschrieben am: 14.09.2020 16:38:54

Hallo Peter,

ich werde nicht so ganz schlau daraus, was Du erreichen möchtest und wie es mit weitere Aufrufen weitergehen soll. Mal angenommen, die Zeilennummer soll immer um 5 weitergezählt werden, dann würde das funktionieren:
Sub Test()
    Dim Zeile As Long, Zelle As Range
    Static Abstand As Long
    Zeile = Range("A1")
    If Zeile = 0 Then Abstand = 0
    For Each Zelle In Range("B2:D5")
        Zeile = Zeile + 1
        Range("F" & Zeile) = Zelle.Offset(Abstand, 0).Address
        Range("G" & Zeile) = Zelle.Value
        Range("A1") = Zeile + 1
    Next Zelle
    Abstand = Abstand + 5
End Sub

Sobald in Zelle A1 wieder 0 steht, geht's von vorn los.

Viele Grüße
Frank

nach oben  nach unten

Betrifft: AW: Zelle.Address
von: Peter
Geschrieben am: 14.09.2020 17:13:06

Hallo Frank,
das ist schon ein guter Lösungsansatz, danke! Allerdings ist der Abstand variabel, kommt auf die Anzahl der Datenzeilen in der Quelldatei an.
Es geht darum, dass ich aus einer begrenzten Anzahl von Lieferscheinen mit mehr oder weniger Einträgen eines Monats eine Sammelrechnung erstellen möchte.
Viel Grüße
Peter

nach oben  nach unten

Betrifft: AW: Zelle.Address
von: Frank Svoboda
Geschrieben am: 14.09.2020 17:24:13

Hallo Peter,
dann gib der Sub doch mit, um wieviel der »Abstand« inkrementieren soll:
Sub Test(ByVal Inkrement As Long)
    Dim Zeile As Long, Zelle As Range
    Static Abstand As Long
    Zeile = Range("A1")
    If Zeile = 0 Then Abstand = 0
    For Each Zelle In Range("B2:D5")
        Zeile = Zeile + 1
        Range("F" & Zeile) = Zelle.Offset(Abstand, 0).Address
        Range("G" & Zeile) = Zelle.Value
        Range("A1") = Zeile + 1
    Next Zelle
    Abstand = Abstand + Inkrement
End Sub

Viele Grüße
Frank

nach oben  nach unten

Betrifft: AW: Zelle.Address
von: Peter
Geschrieben am: 14.09.2020 17:31:54

Hallo Frank,
vielen Dank! Ich werde das mal im Original einfügen und meinen Erfolg kundtun!
Der Vorschlag ist gut!
Viele Grüße, Peter

nach oben  nach unten

Betrifft: AW: Zelle.Address
von: Peter
Geschrieben am: 15.09.2020 08:23:06

Hallo Frank,
in leichter Abwandlung läuft das Makro einwandfrei, einfach super!
Sub Werte_kopieren()
    Zeile = Range("A1")
    Application.Run "Werte_eintragen", Zeile
End Sub

Sub Werte_eintragen(ByVal Inkrement As Long)
     Dim Zeile As Long, Zelle As Range
     Static Abstand As Long
     Zeile = Range("A1")
     If Zeile = 0 Then Abstand = 0
     For Each Zelle In Range("B2:D15")
        Zeile = Zeile + 1
        If Zelle.Value <> "" Then
            Range("F" & Zeile) = Zelle.Offset(Abstand, 0).Address
            Range("G" & Zeile) = Format(Zelle.Value, "@")
            Range("A1") = Zeile + 1
        End If
     Next Zelle
     Abstand = Abstand + Range("B1")    ' B1 = Anzahl nicht leerer Zellen in Spalte B
 End Sub
Allerdings habe ich da noch ein Problm, habe ich gestern auch nicht bedacht:
Das erste Rechnungsblatt hat die Zeilen 23 bis 47 zur Verfügung, das zweite 69 bis 103.
Wenn ich nun mit meiner Aktion über die Zeile 47 hinauskomme, muss zwangsläufig ab Zeile 69 weiter eingefügt werden. Da komme ich momentan nicht weiter.
Viele Grüße
Peter

nach oben  nach unten

Betrifft: AW: Zelle.Address
von: ralf_b
Geschrieben am: 15.09.2020 09:53:25

Vielleicht zeigst du uns mal dein Gesamtkonstrukt. Ich bin mir fast sicher, das da ein Ansatzpunkt für eine "ordentliche" Lösung zu finden ist.

nach oben  nach unten

Betrifft: AW: Zelle.Address
von: Peter
Geschrieben am: 15.09.2020 11:05:46

Hallo Ralf,

das ist jetzt ein bischen länger. Die Erklärungen habe ich vor Beginn der Kopier-Routine eingefügt, ich hoffe, verständlich.

Danke für die Hilfe

Peter
Sub Werte_eintragen(ByVal Inkrement As Long)
     Dim Zeile As Long, Zelle As Range
     Static Abstand As Long
     Zeile = Range("A1")
     If Zeile = 0 Then Abstand = 0
     For Each Zelle In Range("B23:F47")
        If Zelle.Value <> "" Then
            Zeile = Zeile + 1
            Range("F" & Zeile) = Zelle.Offset(Abstand, 0).Address
            Range("G" & Zeile) = Zelle.Value
            Range("A1") = Zeile + 1
        End If
     Next Zelle
     Abstand = Abstand + Range("A2")
End Sub

Sub Lieferschein_Backup()

    Dim QBL As Worksheet
    Dim ZBL As Worksheet
    
    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
        .Cursor = xlWait
    End With
         
'   --------------------------------
'   Alle anderen Dateien schließen
'   --------------------------------
    For Each wkb In Workbooks
          If (wkb.Name <> ActiveWorkbook.Name) And (wkb.Name <> ThisWorkbook.Name) Then
          wkb.Close savechanges:=False
       End If
    Next wkb

'   --------------------------------
'   Hole Daten aus Original-Rechnung
'   --------------------------------
    With Worksheets("Rechnung")
        Datum = .Range("I16")
        Jahr = Year(Datum)
        MM = Format(Datum, "MM")
        MMM = Format(Datum, "MMM")
        Monat = MM & " - " & MMM
        If Left(Datum, 2) < 15 Then ZR = "  -  01 bis 14  " & MMM
        If Left(Datum, 2) > 14 Then ZR = "  -  15 bis Ende  " & MMM
    End With
    
    
'   --------------
'   Vorbereitungen
'   --------------
    With ThisWorkbook
        Pfad = .Path & "\Backup\Lieferschein " & Jahr & "\" & MM & " - " & MMM & "\"
        ART = Range("I14")
        KD_Art = Range("O12")
        Datei = "Kunde " & Range("F18") & "-" & KD_Art & ZR & " - " & Jahr
        ZD = Pfad & Datei & ".xlsx"
    End With
    
'   ---------------------------------
'   Backup-Datei erstellen, Blatt
'   Rechnungen formatieren, speichern
'   ---------------------------------
    On Error Resume Next
        If Dir(ZD) = "" Then
            With Workbooks
                .Add
                 With ActiveWorkbook
                     With .Sheets(1)
                        .Name = "Rechnung"
                     End With
                    .SaveAs ZD
                    .Close False
                 End With
            End With
        End If
        Workbooks.Open ZD
    On Error GoTo 0
    
    With Workbooks(2)
        .Activate
    End With
    
    Set QBL = Workbooks(1).Sheets("Rechnung")   ' Quelle
    Set ZBL = Workbooks(2).Sheets("Rechnung")   ' Ziel
    
    On Error Resume Next
    
    ZBL.Unprotect
    
'   ############################################################
'   Ab hier beginnt die Kopierroutine, die Kopfzeilen aus dem
'   Rechnungsformular, allerdings habe ich das Makro
'   "Werte eintragen" wohl noch nicht richtig eingebunden,
'   in meiner Testdatei funktioniert es, hier noch nicht.
'   ------------------------------------------------------------
'   Zunächst wird der Kopfbereich aus "B1:O18" kopiert, danach
'   der Rechnungsbereich, wobei hier die Eintragungen angehängt,
'   die Zell-Adressen entsprechend angepasst werden müssen.
'   Der Lieferschein hat nur eine Seite, die Rechnung vier,
'   der beschreibbare Bereich: B23:F47, B69:F103, B120:F154,
'   B171:F2205
'   ------------------------------------------------------------
'   Da der Inhalt der gesamten Lieferscheine die jeweiligen
'   Schallgrenzen überschreitet, müssen entsprendend die Zell-
'   adressen angepasst werden.
'   ############################################################
    
'   -----------------------
'   Backup Kopfbereich
'   -----------------------
    If Range("B1") = "" Then
       With QBL
           Set Bereich = .Range("B1:O18")
           For Each Zelle In Bereich
              If Zelle.Locked = False And Zelle.Value <> "" Then
                  Zeile = Zeile + 1                                       ' Zeile hochzählen
                  ADR = Zelle.Address
                  Range("B" & Zeile) = Zelle.Address                      ' Quell-Zell-Adresse
                  Range("C" & Zeile) = Zelle.Value                        ' Quell-Zellinhalt
                  ADR = Range("B" & Zeile)                                ' Quell-Zell-Adresse   _
_
in Variable
              End If
           Next Zelle
       End With
       Range("A1") = Zeile + 1
    End If
         
    Range("A2") = QBL.Range("B22")

'   -----------------------
'   Backup Rechnungsbereich
'   -----------------------
    Zeile = Range("A1")
    With QBL
       Application.Run "Werte_eintragen", Zeile
    End With
         
    On Error GoTo 0
    
    With ActiveWorkbook
        '.SaveAs ZD
        '.Close False
    End With
    
Ende:


    
    With Application
        .ScreenUpdating = True
        .DisplayAlerts = True
        .Cursor = xlDefault
    End With

End Sub


nach oben  nach unten

Betrifft: AW: Zelle.Address
von: ralf_b
Geschrieben am: 15.09.2020 17:46:32

sorry, ich bin leider kein Nerd, der den Code wie ein Kinderbuch liest.

Ich dachte eher an die Datei. Code mit Tabellen. Zum ausprobieren. Aber macht ja nichts. Für mich ist das heute zu schwere Kost.

nach oben  nach unten

Betrifft: AW: Zelle.Address
von: Peter
Geschrieben am: 15.09.2020 17:50:10

Hallo Ralf,
habe ich vorhin schon hochgeladen, aber ist wohl noch nicht zu sehen. Klar, aus dem Makro ist das nicht wirklich gut zu ergründen.
Gruß, Peter

nach oben  nach unten

Betrifft: AW: Zelle.Address
von: Peter
Geschrieben am: 15.09.2020 17:59:42

So, jetzt aber: https://www.herber.de/bbs/user/140251.zip

nach oben  nach unten

Betrifft: AW: Zelle.Address
von: ralf_b
Geschrieben am: 15.09.2020 18:53:33

na gut folgende Idee basierend auf einem nur kurzen Blick auf den Code und einer Mutmaßung zum Gesamtworkflow.

Ziel ist es eine mehrseitige Rechnung korrekt ohne die Seitenformatierung zu sprengen zu erzeugen.
Du hast die beschreibbaren Bereiche identifiziert und nun geht es darum diese der Reihe nach zu befüllen. Zum Befüllen ziehst du mehrere Lieferscheine heran.
Und das ist auch die Kopierroutine vom Eingangspost.

Vorschlag: Erzeuge ein Array global, in welchem die Zeilennummern der beschreibbaren Bereiche gespeichert werden. Die sind ja sicher immer gleich.

Wenn du die Lieferscheine einliest kannst du dann Zeile für Zeile befüllen, indem du nur durch das Array gehst und die Zeilennummer holst. Wenn du herausfinden willst welche die letzte genutzte Zeile in deiner Rechnung ist, dann kannst du das über die .end(xlup) einer Spalte herausfinden oder du markierst die Zeile in einer weiteren dimension mit z.b. einem "x".

Set QBL = Workbooks(1).Sheets("Rechnung") ' Quelle
Set ZBL = Workbooks(2).Sheets("Rechnung") ' Ziel

du kopierst die Werte von Quelle zu Ziel? Wenn das nur eine (Backup)Kopie sein soll ,dann kannst du doch das eine Sheet als Kopie in die Zieldatei kopieren und fertig.

Aber so ganz hab ich den Ablauf das totzdem noch nicht geblickt.

gruß ralf_b