Top-Themen

AppleEntwicklungHardwareInternetLinuxMicrosoftMultimediaNetzwerkeOff TopicSicherheitSonstige SystemeVirtualisierungWeiterbildungZusammenarbeit

Aktuelle Themen

Administrator.de FeedbackApache ServerAppleAssemblerAudioAusbildungAuslandBackupBasicBatch & ShellBenchmarksBibliotheken & ToolkitsBlogsCloud-DiensteClusterCMSCPU, RAM, MainboardsCSSC und C++DatenbankenDatenschutzDebianDigitiales FernsehenDNSDrucker und ScannerDSL, VDSLE-BooksE-BusinessE-MailEntwicklungErkennung und -AbwehrExchange ServerFestplatten, SSD, RaidFirewallFlatratesGoogle AndroidGrafikGrafikkarten & MonitoreGroupwareHardwareHosting & HousingHTMLHumor (lol)Hyper-VIconsIDE & EditorenInformationsdiensteInstallationInstant MessagingInternetInternet DomäneniOSISDN & AnaloganschlüsseiTunesJavaJavaScriptKiXtartKVMLAN, WAN, WirelessLinuxLinux DesktopLinux NetzwerkLinux ToolsLinux UserverwaltungLizenzierungMac OS XMicrosoftMicrosoft OfficeMikroTik RouterOSMonitoringMultimediaMultimedia & ZubehörNetzwerkeNetzwerkgrundlagenNetzwerkmanagementNetzwerkprotokolleNotebook & ZubehörNovell NetwareOff TopicOpenOffice, LibreOfficeOutlook & MailPapierkorbPascal und DelphiPeripheriegerätePerlPHPPythonRechtliche FragenRedHat, CentOS, FedoraRouter & RoutingSambaSAN, NAS, DASSchriftartenSchulung & TrainingSEOServerServer-HardwareSicherheitSicherheits-ToolsSicherheitsgrundlagenSolarisSonstige SystemeSoziale NetzwerkeSpeicherkartenStudentenjobs & PraktikumSuche ProjektpartnerSuseSwitche und HubsTipps & TricksTK-Netze & GeräteUbuntuUMTS, EDGE & GPRSUtilitiesVB for ApplicationsVerschlüsselung & ZertifikateVideo & StreamingViren und TrojanerVirtualisierungVisual StudioVmwareVoice over IPWebbrowserWebentwicklungWeiterbildungWindows 7Windows 8Windows 10Windows InstallationWindows MobileWindows NetzwerkWindows ServerWindows SystemdateienWindows ToolsWindows UpdateWindows UserverwaltungWindows VistaWindows XPXenserverXMLZusammenarbeit
GELÖST

VBA Zeilen in andere Tab kopieren

Frage Entwicklung VB for Applications

Mitglied: matester

matester (Level 1) - Jetzt verbinden

30.07.2010, aktualisiert 18.10.2012, 7161 Aufrufe, 7 Kommentare

Hallo zusammen,

ohne Eure Unterstützung will es einfach nicht funktionieren!!!

23d7cc985ae29f4b21fbb16407989acb - Klicke auf das Bild, um es zu vergrößern

Suche in Tab1 Spalte D nach "K/E" (wenn gefunden) dann kopiere die Nummer aus Spalte A in Tab2 in die Spalte mit den ensprechenden Tagen (siehe Bild Tab2). Nummer "809306" in die Spalte >1000 Tage.
Next "K/E.

3ab95a66fe5564bef051592cfad55352 - Klicke auf das Bild, um es zu vergrößern

Alle "K/E" gefunden und kopiert, weiter mit "K/M" (siehe Tab 3)

Suche in Tab1 Spalte D nach "K/M" (wenn gefunden) dann kopiere die Nummer aus Spalte A in Tab3 in die Spalte mit den ensprechenden Tagen (siehe Bild Tab3). Nummer "801561" und "802277" in die Spalte 101 - 249 Tage.
Next "K/M.

4b6375a1e8dc9dea80a8a8cab1a7be5c - Klicke auf das Bild, um es zu vergrößern



Bild für die Erweiterung

f01be9742f5cd8da258df05abda72b11 - Klicke auf das Bild, um es zu vergrößern


Hier Bild Tab Extra 2

633a3c06073754e2707fe4ada4742d66 - Klicke auf das Bild, um es zu vergrößern



Ergebnis Code 2

c7ca9b8d941f418b60687a7ca3d40d98 - Klicke auf das Bild, um es zu vergrößern
Mitglied: bastla
31.07.2010 um 01:18 Uhr
Hallo matester!

Versuch es damit:
01.
Sub Zuordnen() 
02.
 
03.
QTabelle = "Tab1" 
04.
QAbZeile = 2 'Daten ab Zeile 2 in 
05.
QSpalte = 1 'Spalte "A" 
06.
 
07.
With Worksheets(QTabelle) 'Quelltabelle vorgeben 
08.
    QZeile = QAbZeile 'in "AbZeile" beginnen 
09.
    Nr = .Cells(QZeile, QSpalte).Value 'Nr auslesen 
10.
    Do While Nr <> "" 'Schleife, solange noch Daten vorhanden sind 
11.
     
12.
        'Kennzeichen "Berich" prüfen und entsprechende Tabelle zuordnen 
13.
        Berich = .Cells(QZeile, QSpalte + 3).Value 
14.
        Select Case Berich 
15.
        Case "K/E" 
16.
            ZTabelle = "Tab2" 
17.
        Case "K/M" 
18.
            ZTabelle = "Tab3" 
19.
        Case Else 
20.
            ZTabelle = "" 
21.
        End Select 
22.
     
23.
        If ZTabelle <> "" Then 'passendes Kennzeichen gefunden 
24.
            Tage = Val(.Cells(QZeile, QSpalte + 2).Value) 'Tageanzahl lesen 
25.
            'Zugeordnete Spalte lt Tageanzahl ermitteln 
26.
            ZSpalte = Switch(Tage <= 100, "B", Tage < 250, "C", Tage <= 500, "D", Tage <= 750, "E", Tage <= 1000, "F", Tage > 1000, "G") 
27.
            'Nächste freie Zelle in der entsprechenden Spalte suchen 
28.
            ZZeile = Worksheets(ZTabelle).Cells(65536, ZSpalte).End(xlUp).Row + 1 
29.
             
30.
            Worksheets(ZTabelle).Cells(ZZeile, ZSpalte).Value = Nr 'Nr eintragen 
31.
 
32.
        Else ' passendes Kennzeichen nicht gefunden 
33.
            MsgBox "Für Nr " & Nr & " (siehe Zeile " & QZeile & ") konnte keine Zuordnung zu einer Zieltabelle vorgenommen werden!" 
34.
            'Exit Sub 'Abbruch 
35.
        End If 
36.
     
37.
        QZeile = QZeile + 1 'nächste Datenteile 
38.
        Nr = .Cells(QZeile, QSpalte).Value 'Nr auslesen 
39.
    Loop 
40.
End With 
41.
MsgBox "Fertig." 
42.
 
43.
End Sub
Da die Überschriften in den Zieltabellen für die Einordnung lt Tageanzahl nur bedingt auswertbar sind, habe ich die entsprechende Funktionaliltät (entsprechend der Vorlage gilt für jede der beide Zieltabellen die selbe Spaltenzuordnung) in der Zeile 26 mit Konstanten hinterlegt.

Ab Zeile 33 kann (derzeit nur angedeutet) auf die Tatsache reagiert werden, dass der "Berich" weder "K/E" noch "K/M" ist; falls solche Quellzeilen einfach zu ignorieren wären, müssten nur die Zeilen 32 und 33 entfernt werden.

Es wird vermutlich noch erforderlich sein, vorweg die Einträge ab Zeile 2 der Zieltabellen zu löschen, da die neuen Einträge immer unterhalb schon bestehendere Inhalte hinzugefügt werden. Eine passende Codezeile könnte im einfachsten Fall so aussehen:
Worksheets("Tab2").Range("A2:G65536").ClearContents
Grüße
bastla
Bitte warten ..
Mitglied: matester
31.07.2010 um 12:08 Uhr
Guten Tag bastla,

eine SUPER Leistung!!! Dieser Code ist eine volle Punktlandung!!!

Vielen Dank für Deine Hilfe, einfach SUPER.


Hier habe ich noch einige Fragen:

1) Wie sieht der Code aus, wenn ich nur die Begriffe auslesen und die Zeilen in eine andere Tabelle kopieren möchte?

2) Ist es möglich auch den Code so zu ändern, dass die Begriffe in der Spalte D automatisch ausgelesen werden,
ohne die Begriffe mit "K/L" vorzugeben??? Also, suche alle Begrigffe in D durch und lege automatisch die
entsprechenden Tabellen mit der Zuordnung der Tagen an?

3) Wie kann ich diesen Code verwenden, wenn ich wie in dem Bild (Tab Extra) nur die Spalten C, E, G, I, K, M
nach den Begriffen "K/E", "K/M", "K/L" . . . ablaufen lassen und dann als 2. Abfrage nach den Spalten
B, D, F, H, J, L nach den selben Begriffen "K/E", "K/M", "K/L" . . .
suchen und je in die Tabellen K/E (Tab2), K/L (Tab3), K/M (Tab4) kopieren möchte?

Ergebnisse wie Bild Tab2 und Bild Tab3


Vielen Dank im Voraus
Bitte warten ..
Mitglied: bastla
31.07.2010 um 22:53 Uhr
Hallo matester!

Die Fragen 1 und 3 (geht es hier um Anzahlen?) sind in der aktuellen Formulierung für mich leider nicht verständlich ...
Zu 2)
Das Gerüst zum Auslesen aller unterschiedlichen Einträge in Spalte D und Erstellen zugeordneter Tabellen könnte etwa so aussehen:
01.
Sub Erstellen() 
02.
 
03.
QTabelle = "Tab1" 
04.
QAbZeile = 2 'Daten ab Zeile 2 in 
05.
QSpalte = "D" 
06.
 
07.
'Kennzeichen auslesen 
08.
Kennzeichen = "#" 'Variable vorbelegen, damit auch der erste Eintrag "links" abgegrenzt ist 
09.
With Worksheets(QTabelle) 'Quelltabelle vorgeben 
10.
    QZeile = QAbZeile 'in "AbZeile" beginnen 
11.
    K = .Cells(QZeile, QSpalte).Value 'Kennzeichen auslesen 
12.
    Do While K <> "" 'Schleife, solange noch Daten vorhanden sind 
13.
        If InStr(Kennzeichen, "#" & K & "#") = 0 Then 'noch nicht in den gesammelten Kennzeichen enthalten 
14.
            Kennzeichen = Kennzeichen & Replace(K, "/", "_") & "#" 'aktuelles Kennzeichen hinzufügen (dabei "/" durch "_" ersetzen) 
15.
        End If 
16.
        QZeile = QZeile + 1 'nächste Datenteile 
17.
        K = .Cells(QZeile, QSpalte).Value 'Kennzeichen auslesen 
18.
    Loop 
19.
End With 
20.
 
21.
'Tabellen erstellen 
22.
Kenn = Split(Mid(Kennzeichen, 2, Len(Kennzeichen) - 2), "#") 'Array erzeugen (vorweg die Begrenzungszeichen an Anfang und Ende eliminieren) 
23.
For Each SheetName In Kenn 'alle Kennzeichen durchgehen 
24.
    IsNew = True 'Schalter; zeigt an, ob Tabellenblatt erstellt werden kann 
25.
    For Each ExistingSheet In Worksheets 'alle bestehenden Tabellenblätter durchgehen und ... 
26.
        If LCase(ExistingSheet.Name) = LCase(SheetName) Then '... überprüfen, ob ein gleichnamiges Blatt bereits vorhanden ist 
27.
            IsNew = False 'Falls ja: Schalter setzen und ... 
28.
            Exit For '... Überprüfung abbrechen 
29.
        End If 
30.
    Next 
31.
    If IsNew Then 'Wenn Blatt mit dem geprüften Namen noch nicht vorhanden ist, ... 
32.
        Set NewSheet = Worksheets.Add(After:=Sheets(Sheets.Count)) '... neues Tabellenblatt am Ende der Mappe hinzufügen und ... 
33.
        NewSheet.Name = SheetName '... entsprechend benennen 
34.
    End If 
35.
Next 
36.
 
37.
Set NewSheet = Nothing 
38.
End Sub
Für jeden unterschiedlichen Eintrag in Spalte D wird (falls noch nicht vorhanden) ein Tabellenblatt hinzugefügt und nach dem Eintrag benannt. Da "K/E" kein zulässiger Tabellenname ist, wird "/" durch "_" ersetzt. In weiterer Folge kann dann das erste Script oben so angepasst werden, dass die Zieltabelle direkt aus dem aus Spalte D ausgelesenen Kennzeichen ermittelt wird.

Kurz zu einem Teilaspekt meines Ansatzes:
Zum Sammeln aller unterschiedlichen Kennzeichen in einem String werden diese durch "#" (kann auch ein anderes, nicht in den Kennzeichen-Werten vorkommendes Zeichen sein) begrenzt hinzugefügt, sodass für das Beispiel mit "K/E", "K/M" und "K/L" nach dem Durchlaufen aller nicht-leeren Zellen in Spalte D (ab Zeile 2) der Inhalt der Variablen "Kennzeichen" "#K_E#K_M#K_L#" lauten würde (die "/" wurden bereits umgewandelt). Die Abgrenzung durch "#" nach beiden Seiten ist erforderlich, damit nicht Teilstrings gefunden und damit einzelne Werte ausgelassen werden - Beispiel: Wenn ein Kennzeichen "K_E2" bereits vorhanden wäre, würde bei einem einfachen Vergleich mit "K_E" das Ergebnis lauten: "schon vorhanden, wird nicht hinzugefügt"; wird aber "#K_E2#" mit "#K_E#" verglichen, gibt es keine Übereinstimmung.

Grüße
bastla
Bitte warten ..
Mitglied: 76109
01.08.2010 um 00:20 Uhr
Hallo bastla!

Den Teil mit dem Testen/Erstellen des jeweiligen Sheets, könnte man der Einfachheit halber auch so machen:
01.
'Snip...... 
02.
 
03.
For Each SheetName In Kenn 
04.
     
05.
    Set NewSheet = Nothing 
06.
     
07.
    On Error Resume Next:  Set NewSheet = Sheets(SheetName):  On Error GoTo 0 
08.
     
09.
    If NewSheet Is Nothing Then 
10.
        Set NewSheet = Worksheets.Add(After:=Sheets(Sheets.Count)):  NewSheet.Name = SheetName 
11.
    End If 
12.
Next 
13.
 
14.
'Snip......
Gruß Dieter
Bitte warten ..
Mitglied: bastla
01.08.2010 um 10:50 Uhr
Hallo Dieter!

Stimmt - sieht so besser aus ...

Grüße
bastla
Bitte warten ..
Mitglied: matester
01.08.2010 um 11:27 Uhr
Hallo bastla,

zu1 wenn der Begriff „K-E“ in Spalte D vorhanden ist, kopiere die entsprechende Zeile In die Tab2 bzw. bei „K-A“ kopiere
die Zeile in Tab3.
Es geht hier nur um das Kopieren, ich möchte VB nur verstehen!!!


Ich habe zur Vereinfachung alle Begriffe auf K-M, K-L, K-E umgestellt (das mit dem Sonderzeichen "/" sieht sehr gefährlich aus).

Wenn ich Sub Erstellen() laufen lasse, bekomme ich das Ergebnis siehe Bild Code 2.
Die neuen Tabellen aber ohne Inhalt.
Was müsste ich aus Sub Erstellen() herausnehmen, wenn die Begriffe nicht "K/E" sondern nur "K-E" lauten würden???
Um den Code schlanker zu gestallten.


zu3 sollten wie in Bild (Tab Extra) nur die Spalten C, E, G, I, K, M nach den Begriffen "K-E", "K-M", "K-L" . . . ausgelesen und
kopiert werden (Ergebnis Bild Tab Extra 2).

Und dann als neue Abfrage sollten wie in Bild (Tab Extra) nur die Spalten B, D, F, H, J, L nach den selben Begriffen
"K-E", "K-M", "K-L" . . . ausgelesen und kopiert werden (Ergenis Bild Tab Extra 2).
D.h. für K-E (in Tab Extra 2), für K-L (in Tab Extra 3), K-M (in Tab Extra 4).


Aber viel wichtiger ist erstmal der Dank, dass du dich diesem Thema angenommen hast sowie die Unterstützung von Dieter!!!

DANKE . . .
Bitte warten ..
Mitglied: bastla
04.08.2010, aktualisiert 18.10.2012
Hallo matester!

Ich nehme an, mit den Infos aus Deinem anderen Thread sind für Dich inzwischen alle 3 Teilbereiche lösbar - falls ja, könntest Du beide Beiträge als "erledigt" kennzeichnen ...

[Edit] Danke [/Edit]

Grüße
bastla
Bitte warten ..
Neuester Wissensbeitrag
Windows 10

Powershell 5 BSOD

(1)

Tipp von agowa338 zum Thema Windows 10 ...

Ähnliche Inhalte
Heiß diskutierte Inhalte
LAN, WAN, Wireless
gelöst Server erkennt Client nicht wenn er ausserhalb des DHCP Pools liegt (28)

Frage von Mar-west zum Thema LAN, WAN, Wireless ...

Outlook & Mail
Outlook 2010 findet ost datei nicht (18)

Frage von Floh21 zum Thema Outlook & Mail ...

Windows Server
Server 2008R2 startet nicht mehr (Bad Patch 0xa) (18)

Frage von Haures zum Thema Windows Server ...