Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen

Markieren von Zeilen mit gleichem Wert in Spalte B

Betrifft: Markieren von Zeilen mit gleichem Wert in Spalte B von: Gussfuss
Geschrieben am: 29.04.2008 15:51:10

Hallo an alle xls-Götter und VBA-Profis,

ich hoffe, Ihr könnt mir helfen...
ich bekomme eine Tabelle, aus der ich pro Kd.nummer (jeweils Spalte B)Bestätigungen erstellen muss.
Jedes Geschäft hat eine Zeile, es können aber auch mehrere Geschäfte zu einer Kd.nummer gehören,
bsp. 6 Zeilen haben in Spalte B die gleiche Kd.nummer... somit hat dieser Kunde 6 Geschäfte gemacht
ich hab (mit meinen bescheidenen VBA-Kenntnissen) versucht, eine For Next - Schleife zu erstellen, in der geprüft wird, ob die Ktonummer noch gleich der vorherigen...pro Kdnummer sollen dann die jeweiligen Zeilen markiert, in ein neues xls-Formular kopiert und dieses Formular unter dieser Kd.nummer abgespeichert werden and so on...bis die Tabelle abgearbeitet ist.
hier mein kläglicher Versuch:

Problem 1 ich kriegs nicht hin, die entsprechenden Zeilen zu kopieren
Problem 2 das abspeichern unter der jeweiligen Kd.nummer klappt noch nicht

Danke vorab schonmal für Eure Hilfe!
Gussfuss

Dim intktonummer As Integer
Dim intZeilenanzahl As Integer
Dim intkdnummer As Integer
Dim intzeile As Integer
Dim intZeilenanzahllast As Integer
Dim strdateinameneu As String
Dim strdateiname As String

intZeilenanzahllast = Cells(Rows.Count, 2).End(xlUp).Row

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

Workbooks.Open ThisWorkbook.Path & "\muster.xls"
Windows("Testdatei.xls").Activate

For intzeile = 2 To intZeilenanzahllast
Beginn:

If Cells(intzeile, 2).Value = Cells(intzeile + 1, 2).Value Then
Range(ActiveCell, Cells(intzeile, 1)).Select
'hier möchte ich in einer Schleife alle Zeilen markieren, die gleiche Ktonummer (Spalte B)aufweisen
intzeile = intzeile + 1
GoTo Beginn
Else: Selection.Copy
Windows("muster.xls").Activate
Range("D4").Select
ActiveSheet.Paste

intkdnummer = Cells(intzeile, 2).Value

With ActiveDocument
.SaveAs ActiveDocument.Path & "\" & intkdnummer 'hier scheitere ich beim Speichern...
.Close
End With

Windows("Testdatei.xls").Activate
End If

Next intzeile

Windows("Testdatei.xls").Activate

With Application
.ScreenUpdating = True
.EnableEvents = True
End With

MsgBox "Bestätigungen wurden abgespeichert!"
End Sub

  

Betrifft: Wie ein vollstd Pgm sieht das aber nicht aus! von: Luc:-?
Geschrieben am: 01.05.2008 03:23:10

Gruß Luc :-?
Tipp: Markiere den Code im Forum und verwende den Zitat-Button!


  

Betrifft: AW: Markieren von Zeilen mit gleichem Wert in Spal von: fcs
Geschrieben am: 01.05.2008 04:08:51

Hallo Gussfuss,

hier dein Code angepasst. Auf die Select und Activate-Anweisungen wurde dabei verzichtet und die Zellbereiche direkt berechnet und kopiert. Für den zu kopierenden Bereich muss du ggf. noch die Nummern der Spalten anpassen. Wegen besserer Übersichtlichkeit sind die Arbitsmappen und Tabellenblätter, die an den Aktionen berteiligt sind als Objekte deklariert.

Gruß
Franz

Sub aaTest()
'  Dim intktonummer As Integer
'  Dim intZeilenanzahl As Integer
'  Dim intkdnummer As Integer
  Dim intzeile As Integer
  Dim intZeile1 As Integer
  Dim intZeileL As Integer
  Dim intZeilenanzahllast As Integer
'  Dim strdateinameneu As String
  Dim vardateiname As Variant
  
  Dim wksAlle As Worksheet
  Dim wbAlle As Workbook
  Dim wksKdnNummer As Worksheet
  Dim wbKdnNummer As Workbook
  
  Set wbAlle = ActiveWorkbook 'Datei mit allen Bestätigungen
  Set wksAlle = ActiveSheet 'Tabellenblatt mit allen Bestätigungen
  'letzte Zeile in Tabellenblatt mit allen Bestätigungen ermitteln
  With wksAlle
    intZeilenanzahllast = .Cells(.Rows.Count, 2).End(xlUp).Row
  End With
  With Application
    .ScreenUpdating = False
    .EnableEvents = False
  End With
  
  With wksAlle
    For intzeile = 2 To intZeilenanzahllast
      'Musterdatei schreibgeschützt öffnen
      Set wbKdnNummer = Workbooks.Open(FileName:=ThisWorkbook.Path & "\muster.xls", _
          ReadOnly:=True)
      Set wksKdnNummer = wbKdnNummer.Worksheets(1) 'Zieltabele für das Kopieren
      intZeile1 = intzeile '1. Zeile der Kundennummer
      'Kundennummer als Dateiname merken
      vardateiname = .Cells(intzeile, 2).Value & ".xls"
      'Zeilenummern erhöhen bis Kundennummern unterschiedlich
      Do While .Cells(intzeile, 2).Value = .Cells(intZeile1, 2).Value _
          And Not intzeile > intZeilenanzahllast
        intZeileL = intzeile ' LetzteZeile der Kundennummer
        intzeile = intzeile + 1
      Loop
      'Zeilen-Zähler wieder um 1 zurücksetzen
      intzeile = intzeile - 1
      'Zellbereich mit Kundennummer kopieren ##Spaltenummern anpassen!!!
      .Range(.Cells(intZeile1, 1), .Cells(intZeileL, 6)).Copy _
          Destination:=wksKdnNummer.Range("D4")
      'Musterdatei unter KundenNr.xls speichern
      wbKdnNummer.SaveAs FileName:=ActiveWorkbook.Path & "\" & vardateiname
      wbKdnNummer.Close
  Next intzeile
  End With
  
  With Application
    .ScreenUpdating = True
    .EnableEvents = True
  End With
  WbAlle.Activate
  MsgBox "Bestätigungen wurden abgespeichert!"
End Sub




  

Betrifft: AW: Markieren von Zeilen mit gleichem Wert in Spal von: Gussfuss
Geschrieben am: 02.05.2008 19:26:36

Hallo Franz,

funktioniert perfekt - hast mir sehr geholfen.
Nochmals vielen Dank und schönes WE!

Gruss
Günther


  

Betrifft: AW: Markieren von Zeilen mit gleichem Wert in Spalte B von: Gussfuss
Geschrieben am: 01.05.2008 09:42:45

Hallo Franz,

muss leider weg und hab erst morgen Zeit, alles zu testen.
vorab mal wieder ein herzliches Dankeschön und einen schönen Feiertag!

Gruss
Günther


 

Beiträge aus den Excel-Beispielen zum Thema "Markieren von Zeilen mit gleichem Wert in Spalte B"