Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1780to1784
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Zelle.Address

Zelle.Address
14.09.2020 13:13:13
Peter
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

13
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Zelle.Address
14.09.2020 13:43:30
ralf_b
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.
AW: Zelle.Address
14.09.2020 14:04:24
Peter
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
Anzeige
AW: Zelle.Address
14.09.2020 16:38:54
Frank
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
Anzeige
AW: Zelle.Address
14.09.2020 17:13:06
Peter
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
AW: Zelle.Address
14.09.2020 17:24:13
Frank
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
Anzeige
AW: Zelle.Address
14.09.2020 17:31:54
Peter
Hallo Frank,
vielen Dank! Ich werde das mal im Original einfügen und meinen Erfolg kundtun!
Der Vorschlag ist gut!
Viele Grüße, Peter
AW: Zelle.Address
15.09.2020 08:23:06
Peter
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
Anzeige
AW: Zelle.Address
15.09.2020 09:53:25
ralf_b
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.
AW: Zelle.Address
15.09.2020 11:05:46
Peter
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)  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

Anzeige
AW: Zelle.Address
15.09.2020 17:46:32
ralf_b
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.
AW: Zelle.Address
15.09.2020 17:50:10
Peter
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
AW: Zelle.Address
15.09.2020 18:53:33
ralf_b
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
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige