Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
332to336
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
332to336
332to336
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Nach Kriterium markieren

Nach Kriterium markieren
05.11.2003 19:11:13
RalfH
Hallo zusammen,

ich habe folgendes Problem:

Ich habe eine Tabelle mit 3 Spalten (Kundennummer, Artikelnummer, Menge) in der eine Kundennummer mehrfach vorkommen kann.

Jetzt möchte ich die Kundennummer in ein Rechnungssheet übertragen, anschließend sollen die zur Kundennummer passenden Artikelnummern und Menge markiert, in das Rechnungssheet übertragen und anschließend alle Zeilen gelöscht werden.

Wie kann ich das ganze als Makro automatisiert laufen lassen.

Schon mal besten Dank

Gruss Ralf

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Nach Kriterium markieren
05.11.2003 19:41:28
Peter
Hallo Ralf,

mit einer Beispiel Mappe wäre es einfacher!

Gruss Peter
AW: Nach Kriterium markieren
05.11.2003 20:00:08
RalfH
Hallo Peter,

ich habe die Datei auf den Server geladen.

https://www.herber.de/bbs/user/1760.xls

Du kannst Dir ja mal das Makro2 anschauen, da habe ich schon mal probiert.
Bis auf das löschen der Zeilen funktioniert es auch.

Bevor ich es vergesse, vor dem löschen der Zeilen soll noch mit "call..." ein vorliegendes Druckmakro aufgerufen werden.

Schon mal besten Dank

Gruß
Ralf
AW: Nach Kriterium markieren
05.11.2003 21:13:01
Andi_H
Hi Ralf,

ich habs nicht geschafft deine Datei zu laden, hab aber mal gebastelt wie ich das machen würde:

Tabelle Kunden und ein Blatt Namens Rechnung
Kundennummer in Spalte A
ArtNr in B und Menge in C

übertragen wird das ganze in Rechnungen, hab einfach mal irgendwelche zellen genommen, mußt du halt anpassen.
Hier der Code


Sub Test()
Dim Lrow As Long
Dim kdnr As String
Dim kunden, rechnung As Worksheet
Set rechnung = Sheets("Rechnung") ' sheetnamen anpassen!!!
Set kunden = Sheets("Kunden") '!!!!
kdnr = InputBox("Bitte Kundennummer eingeben") ' Kundennummer abfragen
If IsEmpty(kunden.Cells(65536, 1)) Then
Lrow = kunden.Cells(65536, 1).End(xlUp).Row ' letzte zelle ermitteln
Else
Lrow = 65536
End If
Dim x, y As Integer
x = 5 ' x ist die Zeilennummer im Sheet Rechnung
y = 2
For i = Lrow To 2 Step -1 ' von letzter Zelle bis Zeile 2 , evtl anpassen
If kunden.Cells(i, 1) = kdnr Then
rechnung.Cells(x, y) = kunden.Cells(i, 1)
rechnung.Cells(x, y + 1) = kunden.Cells(i, 2)
rechnung.Cells(x, y + 2) = kunden.Cells(i, 3)
kunden.Rows(i).Delete
x = x + 1
End If
Next
End Sub

gruß

andi
Anzeige
AW: Nach Kriterium markieren
05.11.2003 21:42:41
RalfH
Hallo Andi,

erst mal besten Dank für Deine Mühe. Aber ich habe auch mal weiter gebastelt, evtl. ist das ganze nicht besonders geschickt und elegant - aber es funktioniert.

Ich füge mal den Code bei:

Application.ScreenUpdating = False
'HdlNr kopieren
Range("A6").Copy
Range("A2").Select
ActiveSheet.Paste
'
'nach HdlNr selektieren
Range("A7").Select
Range("A5:C366").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _
"A1:A2"), CopyToRange:=Range("E5:G5"), Unique:=False
'HdlNr in Lieferschein
Range("A2").Copy
Windows("LIEFERSCHEIN.XLS").Activate
Sheets("Lieferschein").Select
Range("I11").Select
Selection.PasteSpecial Paste:=xlValues
'Positionen in Lieferschein
Windows("RUECKSTAENDE.XLS").Activate
Sheets("Liefer").Select
Range("F6:G30").Copy
Windows("LIEFERSCHEIN.XLS").Activate
Sheets("Lieferschein").Select
Range("C20").Select
Selection.PasteSpecial Paste:=xlValues
'
'Lieferschein drucken
'call M_Auftrag_manuell
'
'verarbeitete Position löschen
Windows("RUECKSTAENDE.XLS").Activate
Sheets("Liefer").Select
Dim i%
Range("a:g").Select
For i = 86 To 6 Step -1
If Cells(i, 5) <> "" Then
Rows(i).EntireRow.Select
Selection.EntireRow.Delete
End If
Next i
Application.ScreenUpdating = True

Nochmal Danke

Gruss Ralf
Anzeige
AW: Nach Kriterium markieren
05.11.2003 22:26:47
Andi_H
Hi Ralf,

die selects kannst du weglassen, die machen den code nur unübersichtlich und bringen nichts

ohne select:

sheets("Lieferschein").Range("I11").PasteSpecial Paste:=xlValues

dim i%
For i = 86 To 6 Step -1
If Sheets("Liefer").Cells(i, 5) <> "" Then Sheets("Liefer").Rows(i).Delete
Next i

mit select:
Sheets("Lieferschein").Select
Range("I11").Select
Selection.PasteSpecial Paste:=xlValues

Sheets("Liefer").Select
Dim i%
Range("a:g").Select
For i = 86 To 6 Step -1
If Cells(i, 5) <> "" Then
Rows(i).EntireRow.Select
Selection.EntireRow.Delete
End If
Next i

grüße
Anzeige
AW: Nach Kriterium markieren
05.11.2003 22:29:43
RalfH
Hallo Andi,

das probier ich gleich mal.

Besten Dank

Gruss
Ralf

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige