AW: VBA zu kompliziert für mich
01.04.2023 17:43:51
Piet
Hallo Frank
ich habe den Code überarbeitet, das Makro hat jetzt drei getrennte Funktionen.
Alle Daten über MsgBox, MHD + Charge gemeinsam, oder MHD oder Charge einzel auswerten.
Probiere es bitte selbst aus. Dazu gibt es noch ein Löschprogramm mit MsgBox Abfrage.
Zum Tabellen Namen, öffne bitte mal den VBA Editor und die VBA Projekt Ansicht!
Dort siehst du zwei getrennte Namen für Tabellen, den VBA Objektnamen und den Reiternamen.
Ich verwende für Tabelle1 den VBA Namen Tabelle1 im Makro. (ist identisch mit Tabellen Namen)
Tabelle2 habe ich auf den VBA Namen "Daten" gesetzt, das musst du bei dir auch machen!
Danach könnt ihr den Reiternamen umbenennen wie ihr wollt, dem Makro ist das egal!
Ich hoffe du hast den Unterschied zwischen VBA Namen und Reiternamen verstanden.
Sonst experimentiere bitte mit einer Testdatei herum, bis es dir klar ist. Man sieht es sofort.
Den Reiternamen (Tabelle) kannst du manuelli aendern, den VBA Namen nur im Editor!
mfg Piet
Dim MHD As Variant, lz As Long
Dim Chrg As Variant, lz2 As Long
Sub Daten_holen_Neu()
Dim AC As Range, n As Integer
Dim Atw As Variant, rw As Long
Chrg = Tabelle1.Range("C5")
MHD = Tabelle1.Range("C6")
If Len(Chrg & MHD) = 0 Then
Atw = MsgBox("Wollen sie ALLE Daten ziehen ?", vbYesNo)
If Atw = vbNo Then Exit Sub
End If
With Tabelle1 'Tabelle1
'LastZell in Tabelle1 und Daten Tabelle
lz2 = Daten.Cells(Rows.Count, 1).End(xlUp).Row
lz = .Cells(Rows.Count, 1).End(xlUp).Row + 1
For rw = 2 To lz2
'Option: Alle Daten auflisten
If Antw = vbYes Then GoTo list
'Option: MHD + Charge gemeinsam auswerten
If Chrg > "" And Daten.Cells(rw, "J") = Chrg And _
MHD > "" And Daten.Cells(rw, "K") = MHD Then GoTo list
'Option: MHD oder Charge einzeln auswerten
If Chrg > "" And Daten.Cells(rw, "J") = Chrg Or _
MHD > "" And Daten.Cells(rw, "K") = MHD Then
list: .Cells(lz, "D") = Chrg 'Charge
.Cells(lz, "J") = MHD 'MHD
.Cells(lz, "A") = .Cells(lz - 1, "A") 'Artikelnummer
.Cells(lz, "B") = .Cells(lz - 1, "B") 'text
.Cells(lz, "C") = .Cells(lz - 1, "C") 'Nummer
.Cells(lz, "F") = Daten.Cells(rw, "F")
.Cells(lz, "N") = Daten.Cells(rw, "E")
lz = lz + 1: n = n + 1
End If
Next rw
End With
If n = 0 Then MsgBox ("keine Daten gefunden")
End Sub
Sub Daten_löschen()
Dim Atw As Variant, rw As Long
With Tabelle1 'Tabelle1
lz = .Cells(Rows.Count, 1).End(xlUp).Row
Atw = MsgBox("Wollen sie ALLE Kunden - Daten löschen ?", vbYesNo)
If Atw = vbNo Then Exit Sub
.Range("A10:R" & lz).ClearContents
.Range("A10").Value = .Range("C4").Value
MsgBox "Bitte Text und Nummer2 neu eingeben !"
End With
End Sub