Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1152to1156
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 mehrere Bedingungen kopieren funktioniert

Zelle mehrere Bedingungen kopieren funktioniert
Bastian
Hallo zusammen,
da ich (warum auch immer) in meinem alten Beitrag nicht mehr schreiben kann, habe ich das hier nur nochmal kurz neu eröffnet, um mich zum einem bei Franz für seine Hilfe zu bedanken und zum anderem, anderen die ein ähnliches Problem haben, zu sagen das die Lösung wunderbar funktioniert.
Also: Vielen Dank nochmal für die schnelle Hilfe! :-)
Habe jetzt bei mir alles soweit angepasst und die Arbeit von vielen Stunden ist jetzt eingedampft auf wenige Minuten.
Viele Grüße
Bastian

Hallo Bastian,
du muss nach dem Übertragen des 1. Satzes Daten eine Suchschleife einbauen für den 2. Satz.
Zusätzlich muss du einen Merker einführen, für die schon nach Word übertragenen Positionen.  _
Diese müssen übersprungen werden, wenn der Zähler i auf diese Positionen trifft.
Ich hab hierfür das Datenfeld bolNachWord eingerichtet.
Nachfolgend deine Prozedur (ungetestet) entsprechend angepasst. Bei Versand von 3 Positionen  _
muss du einen weiteren ähnlichen Block einfügen. Der For-Next-Zähler muss dann bei j+1  _
weitermachen.
Gruß
Franz
Sub test()
Dim appWord As Object
Dim Bestellvorlage As Object, bolNachWord() As Boolean
Dim i As Long, j As Long, ZeileLetzte As Long
Dim Bestellvorlagespeichern As String
ZeileLetzte = 10
ReDim bolNachWord(4 To ZeileLetzte) ' oberer Wert identisch mit For-Next-Schleifen-Zähler
For i = 4 To ZeileLetzte 'Zur Vereinfachung nur diese beiden Zeilen
If bolNachWord(i) = False Then
' In Spalte 29 ist das Summenprodukt aus Stichwort, Lieferantenname und Bestellort - hier    _
_
_
gibt _
es also unter einem Stichwort, einen Lieferanten der an einen Standort liefert mit 2  _
Positionen
If Cells(i, 29) = 2 And Cells(i, 7) = "Bogen" Then
' Richtige Bestellvorlage öffnen
Set appWord = CreateObject("Word.Application")
Set Bestellvorlage = _
appWord.Documents.Open("P:\Periodika 2011\Vorlagen\Jahresplanung_Bogen_2Positionen_Test")
appWord.Visible = True
'Bestellvorlage mit Daten der Excelliste befüllen - die mit " ' "gekennzeichneten sind die   _
_
_
_
Felder für die 2. Bestellposition die Probleme bereiten.
' Die korrekte Spalte ist bereits angegeben, die Zeile ist mit einem "?" versehen.
Bestellvorlage.Bookmarks("Lieferantenname").Range.Text = Cells(i, 19).Value
Bestellvorlage.Bookmarks("Bogenanzahl1").Range.Text = Cells(i, 10).Value
Bestellvorlage.Bookmarks("Papier1").Range.Text = Cells(i, 8).Value
Bestellvorlage.Bookmarks("Grammatur1").Range.Text = Cells(i, 2).Value
Bestellvorlage.Bookmarks("Format1").Range.Text = Cells(i, 5).Value
Bestellvorlage.Bookmarks("Laufrichtung1").Range.Text = Cells(i, 6).Value
bolNachWord(i) = True
'Zeile mit 2. Eintrag suchen
'Stichwort: 1 (A)
'Lieferantenname: 11 (K)
'Bestellort: 12 (L)
'Summenprodukt aus Stichwort, Lieferantenname, Bestellort: 29 (AC)
For j = i + 1 To ZeileLetzte
If Cells(j, 1) = Cells(i, 1) And Cells(j, 11) = Cells(i, 11) _
And Cells(j, 12) = Cells(i, 12) Then
Bestellvorlage.Bookmarks("Bogenanzahl2").Range.Text = Cells(j, 10).Value
Bestellvorlage.Bookmarks("Papier2").Range.Text = Cells(j, 8).Value
Bestellvorlage.Bookmarks("Grammatur2").Range.Text = Cells(j, 2).Value
Bestellvorlage.Bookmarks("Format2").Range.Text = Cells(j, 5).Value
Bestellvorlage.Bookmarks("Laufrichtung2").Range.Text = Cells(j, 6).Value
bolNachWord(j) = True
Exit For
End If
Next j
Bestellvorlage.Bookmarks("Datum1").Range.Text = Cells(i, 33).Value
'Speichern der Bestellvorlage unter Zellbezügen
Bestellvorlagespeichern = "P:\Periodika 2011\Bestellungen Periodika 2011\Jahresplanung  _
2011_" & _
Workbooks("Bogenberechnung Test").Sheets("Periodika 2011").Cells(i, 12).Value & "_" & _
Workbooks("Bogenberechnung Test").Sheets("Periodika 2011").Cells(i, 11).Value & "_" _
& Workbooks("Bogenberechnung Test").Sheets("Periodika 2011").Cells(i, 1).Value & ".doc"
Bestellvorlage.SaveAs Filename:=Bestellvorlagespeichern
appWord.Documents.Close
appWord.Quit
End If
End If
Next i
Set Bestellvorlage = Nothing
Set appWord = Nothing
End Sub

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Benutzer
Anzeige
dann ist ja gut owT
19.04.2010 13:27:17
geschlossen
Anzeige

300 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige