Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1504to1508
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

fuer alle sheets Bedingungen durchlaufen

fuer alle sheets Bedingungen durchlaufen
26.07.2016 03:27:20
hilde
Halli Hallo,
habe ein Problem mit meinem VBA Code bzw. mit der Loesung des Problems...
Bin noch ein Neuling in der VBA-Welt.
Mein Problem ist es, dass ich von einer Datei mit Infos (siehe Link Sheet:src)
Daten in ein Layout (siehe dst) bekommen moechte. Dabei ist fuer jede Item# ein Sheet mit dem Layout angelegt.
Jetzt moechte ich wenn die Item# von der Datei "src" mit der in der Layout Datei "dst" auf einem der zielsheets(Voreingetragen) uebereinstimmt, bestimmte Daten (siehe Code) aus der selben Zeile der "src" in bestimmte Felder des Layouts uebertragen.
Bitte um Hilfe.
https://www.herber.de/bbs/user/107239.xlsx
Private Sub CommandButton1_Click()
Dim src As Workbook
Dim dst As Workbook
Dim ChFile As Variant
Dim dstFile As Variant
Dim ws As Worksheet
Dim x As Range
dstFile = Application.GetOpenFilename
If dstFile = False Then
MsgBox "Action canceled!"
Exit Sub
End If
Set dst = Workbooks.Open(dstFile)
ChFile = Application.GetOpenFilename
If ChFile = False Then
MsgBox "Action canceled!"
Exit Sub
End If
Set src = Workbooks.Open(ChFile)
dst.Activate
For Each ws In dst.Sheets
Set ws = dst.ActiveSheet
such = ws.Range("y5")
Set x = src.Sheets("Sheet1").Range("B:B").Find(what:=such, Lookat:=xlWhole)
If Not x Is Nothing Then
x = x.Row  '-->x wird in src file =dem wert gesetzt
End If
If IsEmpty(dst.ActiveSheet.Range("ap5").Value) = True Then
dst.ActiveSheet.Range("ap5") = src.Sheets("Sheet1").Cells(x, 11)
End If
'Insert Vendor Name
If IsEmpty(dst.ActiveSheet.Range("n6").Value) = True Then
dst.ActiveSheet.Range("n6") = src.Sheets("Sheet1").Cells(x, 12)
End If
'Insert Abbrev. Title
If IsEmpty(dst.ActiveSheet.Range("n7").Value) = True Then
dst.ActiveSheet.Range("n7") = src.Sheets("Sheet1").Cells(x, 13)
End If
'Insert Title row 11
If IsEmpty(dst.ActiveSheet.Range("n11").Value) = True Then
dst.ActiveSheet.Range("n11") = src.Sheets("Sheet1").Cells(x, 14)
End If
'Insert Title row 82
If IsEmpty(dst.ActiveSheet.Range("q82").Value) = True Then
dst.ActiveSheet.Range("q82") = src.Sheets("Sheet1").Cells(x, 14)
End If
'Insert Retail Pack Weight
If IsEmpty(dst.ActiveSheet.Range("t17").Value) = True Then
dst.ActiveSheet.Range("t17") = src.Sheets("Sheet1").Cells(x, 16)
End If
'Insert Retail Pack Width
If IsEmpty(dst.ActiveSheet.Range("ac17").Value) = True Then
dst.ActiveSheet.Range("ac17") = src.Sheets("Sheet1").Cells(x, 17)
End If
'Insert Retail Pack height
If IsEmpty(dst.ActiveSheet.Range("ah17").Value) = True Then
dst.ActiveSheet.Range("ah17") = src.Sheets("Sheet1").Cells(x, 18)
End If
'Insert Retail Pack Depth
If IsEmpty(dst.ActiveSheet.Range("am17").Value) = True Then
dst.ActiveSheet.Range("am17") = src.Sheets("Sheet1").Cells(x, 19)
End If
'Insert Master Carton Weight
If IsEmpty(dst.ActiveSheet.Range("t18").Value) = True Then
dst.ActiveSheet.Range("t18") = src.Sheets("Sheet1").Cells(x, 20)
End If
'Insert Master Carton Width
If IsEmpty(dst.ActiveSheet.Range("ac18").Value) = True Then
dst.ActiveSheet.Range("ac18") = src.Sheets("Sheet1").Cells(x, 21)
End If
'Insert Master Carton height
If IsEmpty(dst.ActiveSheet.Range("ah18").Value) = True Then
dst.ActiveSheet.Range("ah18") = src.Sheets("Sheet1").Cells(x, 22)
End If
'Insert Master Carton Depth
If IsEmpty(dst.ActiveSheet.Range("am18").Value) = True Then
dst.ActiveSheet.Range("am18") = src.Sheets("Sheet1").Cells(x, 23)
End If
'Insert Master Pack Qty
If IsEmpty(dst.ActiveSheet.Range("j27").Value) = True Then
dst.ActiveSheet.Range("j27") = src.Sheets("Sheet1").Cells(x, 26)
End If
'Insert Battery Type
If IsEmpty(dst.ActiveSheet.Range("bf31").Value) = True Then
dst.ActiveSheet.Range("bf31") = src.Sheets("Sheet1").Cells(x, 28)
End If
'Insert Battery Qty
If IsEmpty(dst.ActiveSheet.Range("bk31").Value) = True Then
dst.ActiveSheet.Range("bk31") = src.Sheets("Sheet1").Cells(x, 29)
End If
'Insert DOM Cost
If IsEmpty(dst.ActiveSheet.Range("n34").Value) = True Then
dst.ActiveSheet.Range("n34") = src.Sheets("Sheet1").Cells(x, 31)
End If
'Insert Country of Origin
If IsEmpty(dst.ActiveSheet.Range("b58").Value) = True Then
dst.ActiveSheet.Range("b58") = src.Sheets("Sheet1").Cells(x, 32)
End If
'Insert Contact Vendor Name
If IsEmpty(dst.ActiveSheet.Range("n66").Value) = True Then
dst.ActiveSheet.Range("n66") = src.Sheets("Sheet1").Cells(x, 33)
End If
'Insert Contact Vendor #
If IsEmpty(dst.ActiveSheet.Range("j67").Value) = True Then
dst.ActiveSheet.Range("j67") = src.Sheets("Sheet1").Cells(x, 34)
End If
'Insert Vendor Email
If IsEmpty(dst.ActiveSheet.Range("j68").Value) = True Then
dst.ActiveSheet.Range("j68") = src.Sheets("Sheet1").Cells(x, 35)
End If
'Insert UPC
If IsEmpty(dst.ActiveSheet.Range("f82").Value) = True Then
dst.ActiveSheet.Range("f82") = src.Sheets("Sheet1").Cells(x, 36)
End If
'Insert Copy
If IsEmpty(dst.ActiveSheet.Range("al82").Value) = True Then
dst.ActiveSheet.Range("al82") = src.Sheets("Sheet1").Cells(x, 37)
End If
'Checkbox checked New Setup/Modification
If dst.ActiveSheet.CheckBoxes("Check Box 8").Value = False And dst.ActiveSheet.CheckBoxes(" _
Check Box 9").Value = False And src.Sheets("Sheet1").Cells(x, 9).Value Like "*etup*" Then
dst.ActiveSheet.CheckBoxes("Check Box 8").Value = True
ElseIf dst.ActiveSheet.CheckBoxes("Check Box 8").Value = False And dst.ActiveSheet.CheckBoxes(" _
Check Box 9").Value = False And src.Sheets("Sheet1").Cells(x, 9).Value Like "*cation*" Then
dst.ActiveSheet.CheckBoxes("Check Box 9").Value = True
End If
'Checkbox checked Gender
If dst.ActiveSheet.CheckBoxes("Check Box 3").Value = False Or dst.ActiveSheet.CheckBoxes("Check  _
Box 4").Value = False Or dst.ActiveSheet.CheckBoxes("Check Box 11").Value = False And src.Sheets("Sheet1").Cells(x, 25).Value Like "*oys*" Then
dst.ActiveSheet.CheckBoxes("Check Box 3").Value = True
ElseIf dst.ActiveSheet.CheckBoxes("Check Box 3").Value = False Or dst.ActiveSheet.CheckBoxes(" _
Check Box 4").Value = False Or dst.ActiveSheet.CheckBoxes("Check Box 11").Value = False And src.Sheets("Sheet1").Cells(x, 25).Value Like "*irls*" Then
dst.ActiveSheet.CheckBoxes("Check Box 4").Value = True
ElseIf dst.ActiveSheet.CheckBoxes("Check Box 3").Value = False Or dst.ActiveSheet.CheckBoxes(" _
Check Box 4").Value = False Or dst.ActiveSheet.CheckBoxes("Check Box 11").Value = False And src.Sheets("Sheet1").Cells(x, 25).Value Like "*nisex*" Then
dst.ActiveSheet.CheckBoxes("Check Box 11").Value = True
End If
'Checkbox checked Battery reqired
If dst.ActiveSheet.CheckBoxes("Check Box 6").Value = False And src.Sheets("Sheet1").Cells(x, 27) _
.Value Like "*es*" Then
dst.ActiveSheet.CheckBoxes("Check Box 6").Value = True
End If
'Checkbox checked Battery included
If dst.ActiveSheet.CheckBoxes("Check Box 7").Value = False And src.Sheets("Sheet1").Cells(x, 30) _
.Value Like "*es*" Then
dst.ActiveSheet.CheckBoxes("Check Box 7").Value = True
End If
Next
End Sub

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: nur eine Demo
26.07.2016 09:56:32
Fennek
Hallo,
da ich es "einfach und übersichtlich" mag, hier eine kleine Demo, die letztendlich einen Word-Serienbrief in Excel simuliert. Es werden NUR ZWEI Tabellen benötigt ("Formular" und "Daten"). Nach Auswahl des Datensatzes (und Start eines kleinen Makros), wird das Formular gefüllt und kann z.B. ausgedruckt werden.
Der Aufbau erfordert die Reihenfolge der "Namen" sorgfälltig zu beachten (ensprechend der Spalten in "Daten"). Der einzige Code ist:

Sub iFormular()
Dim Nm As Name
i = Sheets(1).Cells(1, "J") + 1
s = 2
With Sheets("Daten")
For Each Nm In Names
Debug.Print Nm.Name, Nm.RefersTo
Nm.RefersTo = .Cells(i, s)
s = s + 1
Next Nm
End With
End Sub
Datailarbeiten für viele Felder müßtest du selber erledigen.
mfg
https://www.herber.de/bbs/user/107240.xlsm
Anzeige
AW: nur eine Demo
26.07.2016 18:43:53
hilde
Ok, vielen Dank erstmal fuer die Antwort. Allerdings trifft es das nicht genau, da die Layouts wie in der Beispieldatei meist mehr als 50 verschiedene Sheets fuer die verschiedenen Artikelnummern beinhalten und vorgegeben sind. Ebenfalls ist die Quelldatei vorgegeben.
Mein Problem ist es in der Quelle die Artikelnummern zu durchlaufen und dabei gleichzeitig alle Layoutsheets zu druchlaufen und beim Treffer der Artikelnummern in den Referenzzellen die bestimmten Daten aus der Quelle ins jeweilige Layout zu bertragen, falls dort noch nicht voreingetragen ist.
AW: nur eine Demo
27.07.2016 07:52:21
Fennek
Hallo,
ein anderer Versuch: Excel ist ein Tabellen-kalkulations-programm, papier-orientiete Formulare sind eine ganz andere Welt. Jeder Versuch diese unterschiedlichen Konzepte zusammen zu zwängen, schafft Probleme.
Deshalb mein Vorschlag, die Word-Serienbrief-funktion zu nutzen. Dann könnte auch jedes Formular einzeln als pfd gespeichert werden.
Aber ich werde den neuen tread mitlesen, welche Ideen andere beitragen.
mfg
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige