---

Bestellversuch1.xls.txt

Hallo Profis,

ich bekomme vom Konstrukteur eine Stückliste mit den notwendigen Bestellinformationen.
Nun möchte ich den Bestellaufwand etwas optimieren. Mit Hilfspalten bekomme ich sicherlich den Großteil an Informationen ausgewertet aber es gibt eine Bestellkonstellation die mir Schwierigkeiten macht.
In einer Zeile steht 1xStahl und 1xAlu zu bestellen, nun möchte ich das diese Zeile automatisch kopiert wird und direkt untendrunter eingefügt wird. In der „originalzeile soll das Alu und in der „kopiezeile“ der Stahl gelöscht werden.
Ich habe eine Beispielliste von Hand erstellt mit Ist(CAD-Daten) und Soll(v.Hand)-Zustand.
Möglichkeit die ich sehe: Mit Wennabfragen in einer Hilfsspalte arbeiten, diese Filtern, kopieren und anschl. die Einträge verändern. Da ist aber die Fehlerquelle Mensch vorhanden.
Gibt es eine bessere Lösung?

------------------
Gruß
    Marco

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Ja.

Vermutlich jedenfalls: Per VBA (Makro) könnte ich mir vorstellen, dass sich das lösen lässt. Der Benutzer aktiviert eine Zelle in der Reihe, die kopiert/eingefügt/geändert werden soll, und drückt auf ein Knöpfchen.

Wie sieht es mit Deinen VBA-Kenntnissen aus? Schmeiß' doch mal den Makrorecorder an...

------------------
DIN1055.de  |  Lastannahmen für Anwender

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Bestellversuch2.xls.txt

ich habe die Datei mal mit den Hilfsspalten versehen. Jetzt kann ich die Spalte I (Abfrage Material) filtern nach dem Kriterium "Beides", diese Zeile kopieren/einfügen und entsprechendes Material/Stückzahl verändern. Was muss ich machen damit dieses auswählen der Spalte "Beides" automatisch funktioniert?
Makroaufzeichnung:
Sub Makro1()
'
' Makro1 Makro
'

'
    Range("I3").Select
    Selection.AutoFilter
    ActiveSheet.Range("$I$3:$J$11").AutoFilter Field:=1, Criteria1:="BEIDES"
    Rows("6:6").Select
    Selection.Copy
    Range("A12").Select
    ActiveSheet.Paste
    Range("D6").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "0"
    Range("F12").Select
    ActiveCell.FormulaR1C1 = "0"
    Range("G12").Select
    ActiveSheet.Range("$I$3:$J$12").AutoFilter Field:=1
    Range("I3").Select
    Selection.AutoFilter
End Sub
Das ist aber nur für diesen einen Fall. Mitunter sind in einer Stückliste 300 Positionen und diese stehen nicht immer an der gleichen Stelle.
Habe ich einen Gedankenfehler in der Vorgehensweise oder gibt es mit Funktionsabfragen eine Lösung?

------------------
Gruß
    Marco

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Guten Abend Marco,

hier mal ein Ansatz . Filter ein/ausschalten klappt; Umbenennen ist noch komplett offen (die Nullen und Einsen für Stahl und Alu); Kopieren habe ich bisher nur zum Einfügen am Ende des Sheets (hinter "Daten von Hand") hinbekommen.

Ich hänge konkret an folgender Stelle: Wie lese ich die Anzahl der Treffer aus dem Filter aus? Diese Anzahl Zeilen müsste dann unterhalb der "Daten aus CAD"-Tabelle eingefügt werden; und dorthin werden dann die Treffer kopiert. Da stehe ich auf dem Schlauch und sehen wohl den Wald vor lauter Bäumen nicht  .

Erstell' Dir eine Sicherungskopie Deiner Mappe und probier mal diesen

Code:

---

Sub FilternKopierenEinfuegen()

  Application.ScreenUpdating = False
  Set objWS = ThisWorkbook.ActiveSheet
  BereichFiltern "Hilfszelle", "BEIDES"
 
  Kopieren
  'und Umbenennen

  FilternAus "Hilfszelle"
  Set objWS = Nothing
  Application.ScreenUpdating = True
End Sub

Private Sub BereichFiltern(strBer As String, strKrit As String)
'Filtert einen in Excel benannten Bereich "strBer" nach "strKrit"

  'Range("Hilfszelle").Select
  objWS.Range(strBer).AutoFilter Field:=1, Criteria1:=strKrit

End Sub

Private Sub Kopieren()

Dim rgFilterErgebnis As Range
Dim i As Integer '1. Zeile im Ergebnisbereich, ohne Überschrift
Dim k As Integer 'letzte Zeile im Ergebnisbereich
Dim rgPaste As Range 'freie Zelle am Ende des Bereiches
Dim l As Range 'Anzahl Treffer
Dim o As Range
Dim p As Integer

  i = Range("CAD_Daten").Row
  k = Range("CAD_Daten").CurrentRegion.Rows.Count
  Set rgPaste = Range("A" & ActiveCell.SpecialCells(xlLastCell).Row + 2)
  'Spaltenüberschriften werden mitgezählt, 1x abziehen:
  'Set rgPaste = Range("A" & i + k - 1)
  rgPaste.Select
  'Spaltenüberschriften werden mitgezählt, 1x Offset:
  i = 1 + i
  k = k + 1
  Set rgFilterErgebnis = Range(i & ":" & k).EntireRow
 
  'Selection.Insert Shift:=xlDown 'Kopierte Zeilen (!) einfügen
  ' Funktioniert leider nicht für einen gefilterten Bereich. Also
  '  vorab so viele Zeilen einfügen, wie Treffer vorhanden.
 
  'Hilfe: http://www.excelforum.com/excel-programming/332476-select-visible-cells-using-vba.html
'  Set l = ActiveSheet.AutoFilter.Range.Rows() 'AnzahlTreffer(rgFilterErgebnis)
  'Set l = l.Offset(1, 0).Resize(l.Rows.Count - 1, 1)
'  Set o = l.SpecialCells(xlVisible)
  '#######
'  p = AnzahlTreffer(l)
  'p = l.SpecialCells(xlVisible).Rows.Count
  'On Error Resume Next
  'Set rng1 = Rng.SpecialCells(xlVisible)
  'On Error GoTo 0
  'If rng1 Is Nothing Then
  'MsgBox "No visible rows"
  'Else
 
  'Activesheet.Autofilter.Range.Columns(1)
  'if l = 0 then...
 
 
  rgFilterErgebnis.Copy
  rgPaste.PasteSpecial
  rgPaste.Select 'Nur EINE Zelle aktivieren
  'Anmerkung: Beim Testen wandert die xlLastCell nach unten, obwohl keine Inhalte vorhanden;
  ' nach einmaligem Speichern wieder behoben.
 

 
  Application.CutCopyMode = False
  Set rgFilterErgebnis = Nothing

End Sub

Private Function AnzahlTreffer(rg As Range) As Integer
'ermittelt die Anzahl der Ergebnisse für aktuellen AutoFilter
Dim m As Integer
Dim n As Integer

  For m = 1 To rg.Rows.Count
    If rg(Cells(m, 1)).EntireRow.Visible = True Then n = 1 + n
  Next m
 
  AnzahlTreffer = n

End Function

Private Sub FilternAus(strBer As String)
'Deaktiviert den Filter im Bereich "strBer" und blendet den Filter aus
  objWS.Range(strBer).AutoFilter
End Sub

---

Wie gesagt: Nichts fertiges, eher eine Diskussionsgrundlage. Ach ja: Benannte Bereiche in der Mappe sind

CAD_Daten =Tabelle2!$A$3:$G$3
Hilfszelle =Tabelle2!$I$3:$J$3

Ohne die hagelt es Fehlermeldungen. Wie willst Du die Sub ausführen - über einen Button im aktuellen Excel-Register? Ob Du die "Fehlerquelle Mensch" jemals gänzlich ausschließen kannst, wage ich zu bezweifeln. Vielleicht lässt sie sich jedoch auf diese Weise minimieren.

------------------
DIN1055.de  |  Lastannahmen für Anwender

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

... und als Ergänzung: Auf Umwegen klappt auch
-Anzahl der Treffer ermitteln (Sub AnzahlTreffer überarbeitet)
-entsprechend viele Zeilen unter "Daten aus CAD" einfügen (neue Sub ZeilenEinfuegen)
-Treffer kopieren, einfügen. (Sub Kopieren überarbeitet)

Code:

---

Private Sub Kopieren()

Dim rgFilterErgebnis As Range
Dim i As Integer '1. Zeile im Ergebnisbereich, ohne Überschrift
Dim k As Integer 'letzte Zeile im Ergebnisbereich
Dim rgTemp As Range 'freie Zelle am Ende des Bereiches
Dim strInsAdr As String 'Adresse nach dem Einfügen der Leerzeilen
Dim p As Integer 'Anzahl Treffer aus Filter

  i = Range("CAD_Daten").Row
  k = Range("CAD_Daten").CurrentRegion.Rows.Count
  'Spaltenüberschriften werden mitgezählt, 1x abziehen:
  Set rgTemp = Range("A" & i + k - 1)
  'Durch das Einfügen der Leerzeilen - siehe unten - wird rgTemp mit
  ' nach unten verschoben - Adresse des Einfügepunktes merken:
  strInsAdr = rgTemp.Address(0, 0)
'  rgTemp.Select
   
  'Spaltenüberschriften werden mitgezählt, 1x Offset:
  k = k + 1
  Set rgFilterErgebnis = Range(i + 1 & ":" & k).EntireRow
     
  'Selection.Insert Shift:=xlDown 'Kopierte Zeilen (!) einfügen
  ' Funktioniert leider nicht für einen gefilterten Bereich. Also
  '  vorab so viele Zeilen einfügen, wie Treffer vorhanden:
  p = AnzahlTreffer(rgFilterErgebnis, i)
  ZeilenEinfuegen rgTemp, p
 
'  rgTemp.Select
  rgFilterErgebnis.Copy
  Range(strInsAdr).PasteSpecial
  Range(strInsAdr).Select
 
  Application.CutCopyMode = False
  Set rgTemp = Nothing
  Set rgFilterErgebnis = Nothing

End Sub

Private Function AnzahlTreffer(rg As Range, iStart As Integer) As Integer
'ermittelt die Anzahl der Ergebnisse für aktuellen AutoFilter
Dim m As Integer
Dim n As Integer

  For m = iStart + 1 To rg.Rows.Count + iStart
    If Rows(m & ":" & m).EntireRow.Hidden = False Then n = 1 + n
  Next m
  AnzahlTreffer = n

End Function

Private Sub ZeilenEinfuegen(rg As Range, nRows As Integer)
'fügt "nRows" Zeilen ab Bereich "rg" ein
Dim o As Integer

  For o = 1 To nRows
    rg.EntireRow.Insert
  Next o

End Sub

---

Sicher lässt sich da noch so einiges optimieren . Jetzt scheint nur noch das "Umbenennen" offen zu sein...

------------------
DIN1055.de  |  Lastannahmen für Anwender

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Bestellversuch3.xls.txt

Hallo,

ich habe den Code zusammengeführt und bei der nachstehenden Zeile steigt mir das Makro aus:

objWS.Range(strBer).AutoFilter Field:=1, Criteria1:=strKrit

Fehlermeldung: Laufzeitfehler 424 / Objekt erforderlich.

Was muss ich verändern? Wo habe ich einen Fehler beim Code-einbinden gemacht?

------------------
Gruß
    Marco

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hi,

Hab mir das alles nicht näher angeschaut, aber da sonst keiner will:
wenn Du in die Private Sub springst, ist Dein objWS leer. Übergib das mit (wie die strBer) oder setz es in der Private neu.

HTH

------------------
Gruß,
runkelruebe          Herr Kann-ich-nich wohnt in der Will-ich-nich-Straße...

System-Info | Dateianhänge | FAQ-ACAD | CAD.de-Hilfe | Sei eine Antilope

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hi,

Du [Edit: Siehe Edit] hast beim Kopieren die ersten beiden Zeilen - gaaaanz oben im Modul - übersehen  . Dort wird

1. Die Variablendeklaration erzwungen (sehr zu empfehlen)
2. Die Variable objWS beschrieben

Füg' diesen kurzen

Code:

---

Option Explicit
Private objWS As Worksheet

---

ganz am Anfang ein. Tust Du das nicht, so wird objWS nicht korrekt belegt --> Fehler. Sollte nun laufen?!

[Edit: Mein Fehler - ich habe die beiden Zeilen nicht aus der Mappe ins Forum kopiert.  /Edit]

------------------
DIN1055.de  |  Lastannahmen für Anwender

[Diese Nachricht wurde von Paulchen am 07. Dez. 2010 editiert.]

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP