Code anpassen (Original von fcs)

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
MsgBox
Bild

Betrifft: Code anpassen (Original von fcs)
von: erichm
Geschrieben am: 31.08.2015 07:48:55

Hallo,
habe aus diesem Beitrag:
https://www.herber.de/forum/archiv/1420to1424/t1423165.htm
nachstehenden Code, der bestens funktioniert.
Ein Teil müsste angepasst werden, ich komme aber nicht drauf:
'Werte aus Tabelle3 einlesen
With wks3
SpalteL = .Cells(3, .Columns.Count).End(xlToLeft).Column
(im Code nachstehend in FETT)
Derzeit wird aus der Tabelle3 die letzte belegte Spalte ausgewählt. Diese müsste jetzt begrenzt werden auf die Spalte AZ.
Ab der Spalte BA müssen Daten eingetragen werden, die beim einlesen nicht berücksichtigt werden dürfen.

Sub Ergebnisse_Zeilen()
  'Ergebnisse für die im Blatt Steuerung eingegebenen Zeilenbereiche berechnen
  Dim wksErgebnis As Worksheet, wks2 As Worksheet, wks3 As Worksheet
  Dim ZeileL As Long, SpalteL As Long
  Dim arrDatum2 As Variant, arrWerte2 As Variant
  Dim arrDatum3 As Variant, arrWerte3 As Variant
  Dim arrErgebnis
  Dim lngK As Long, lngSpa2 As Long, lngSpa3 As Long, lngZei2 As Long, lngZei3 As Long
  Dim lngZeile_3 As Long, lngZeile_E As Long
  Dim lngCount As Long, ZeilenBlock As Long
  Dim StatusCalc As Long
  Dim datStart As Date
  
  Dim lngZei2_1, lngZei2_L, lngZei3_1, lngZei3_L
  
  'auszuwertende Zeilenbereiche einlesen
  With ThisWorkbook.Worksheets("Steuerung")
    lngZei2_1 = .Range("Tab2_Zeile_1").Value '1. Zeile in Tabelle2
    lngZei2_L = .Range("Tab2_Zeile_L").Value 'letzte Zeile in Tabelle2
    
    lngZei3_1 = .Range("Tab3_Zeile_1").Value '1. Zeile in Tabelle3
    lngZei3_L = .Range("Tab3_Zeile_L").Value 'letzte Zeile in Tabelle3
  End With
  
  datStart = Time      'zum Testen der Makro-Laufzeit
  With Application
    .ScreenUpdating = False
    StatusCalc = .Calculation
    .Calculation = xlCalculationManual
  End With
  
  With ActiveWorkbook
    Set wksErgebnis = .Worksheets("Ergebnis")
    Set wks2 = .Worksheets("Tabelle2")
    Set wks3 = .Worksheets("Tabelle3")
  End With
  
  
  'Ergebnis
  With wksErgebnis
    lngZeile_E = 2 + (lngZei3_1 - 2) '1. Einfügezeile im Ergebnisblatt
        '1. 2 = Datumszeile im Ergebnisblatt
        '2. 2 = 1. Anzahl Zeilen oberhalb der Wertezeilen
  End With
  'Werte aus Tabelle2 einlesen
  With wks2
    SpalteL = .Cells(3, .Columns.Count).End(xlToLeft).Column
    ZeileL = .Cells(.Rows.Count, 1).End(xlUp).Row
    If lngZei2_1 >= 3 And lngZei2_L <= ZeileL Then
      arrDatum2 = Application.WorksheetFunction.Transpose(.Range(.Cells(lngZei2_1, 1), _
            .Cells(lngZei2_L, 1)))
    Else
      MsgBox "Die gewählten Zeilen für Tabelle """ & .Name & """liegen außerhalb des  _
Datenbereichs", _
            vbOKOnly, "Einlesen Werte aus " & .Name
      GoTo Beenden
    End If
    If SpalteL >= 2 Then
      arrWerte2 = .Range(.Cells(lngZei2_1, 2), .Cells(lngZei2_L, SpalteL))
    Else
      MsgBox "Keine Werte in Tabelle """ & .Name & """", _
            vbOKOnly, "Einlesen Werte aus " & .Name
      GoTo Beenden
    End If
  End With
  
  'Werte aus Tabelle3 einlesen
  With wks3
    SpalteL = .Cells(3, .Columns.Count).End(xlToLeft).Column
    ZeileL = .Cells(.Rows.Count, 1).End(xlUp).Row
    If lngZei3_1 >= 3 And lngZei3_L <= ZeileL Then
      arrDatum3 = .Range(.Cells(lngZei3_1, 1), .Cells(lngZei3_L, 1))
    Else
      MsgBox "Die gewählten Zeilen für Tabelle """ & .Name & """liegen außerhalb des  _
Datenbereichs", _
            vbOKOnly, "Einlesen Werte aus " & .Name
      GoTo Beenden
    End If
    If SpalteL >= 2 Then
    Else
      MsgBox "Keine Werte in Tabelle """ & .Name & """", _
            vbOKOnly, "Einlesen Werte aus " & .Name
      GoTo Beenden
    End If
    
    datStart = Time     'zum Testen der Makro-Laufzeit
    
    ZeilenBlock = 100 'Anzahl Zeilen aus Tabelle3 die jeweils als Block abgearbeitet _
        werden (max. ca. 5000 Zeilen bei 6000 Spalten). Die Blockgröße beinflusst _
        die Geschwindigkeit nur marginal
    
    For lngZeile_3 = lngZei3_1 To lngZei3_L Step ZeilenBlock
'      If lngZeile_3 > 400 Then Exit For 'Testzeile, um Laufzeit zu begrenzen
      
      Application.StatusBar = "Zeile " & lngZeile_3 & " bis " & lngZeile_3 + ZeilenBlock & "  _
von " & ZeileL & " wird bearbeitet"
      If lngZeile_3 + ZeilenBlock - 1 > lngZei3_L Then
        arrWerte3 = .Range(.Cells(lngZeile_3, 2), .Cells(lngZei3_L, SpalteL))
      Else
        arrWerte3 = .Range(.Cells(lngZeile_3, 2), .Cells(lngZeile_3 + ZeilenBlock - 1, SpalteL)) _
      End If
      'Ergebnis-Array dimensionieren ( bis ca. 65000 Zeilen, bis ca. 6000 Spalten)
      ReDim arrErgebnis(LBound(arrWerte3, 1) To UBound(arrWerte3, 1), _
            LBound(arrDatum2, 1) To UBound(arrDatum2, 1))
      'Zeilen Tabelle 3 abarbeiten
      For lngZei3 = LBound(arrWerte3, 1) To UBound(arrWerte3, 1)
          'Zeilen Tabelle2 abarbeiten
          For lngZei2 = LBound(arrDatum2, 1) To UBound(arrDatum2, 1)
            
            lngCount = 0
            'Werte in Zeile Tabelle 3 mit Werten in Zeile Tabelle2 vergleichen
            For lngSpa3 = LBound(arrWerte3, 2) To UBound(arrWerte3, 2)
              For lngSpa2 = LBound(arrWerte2, 2) To UBound(arrWerte2, 2)
                If arrWerte3(lngZei3, lngSpa3) = arrWerte2(lngZei2, lngSpa2) Then
                  lngCount = lngCount + 1
                End If
              Next lngSpa2
            Next lngSpa3
            arrErgebnis(lngZei3, lngZei2) = lngCount
          Next lngZei2
      Next lngZei3
      
      'Ergebnisse des Blocks im Ergebnisblatt eintragen
      With wksErgebnis
        .Cells(lngZeile_E, 2 + (lngZei2_1 - 2)).Resize(UBound(arrErgebnis, 1), UBound( _
arrErgebnis, 2)) = arrErgebnis
      End With
      'Einfügezeile für nächsten Block
      lngZeile_E = lngZeile_E + ZeilenBlock
      'Arrays leeren
      Erase arrWerte3, arrErgebnis
      
    Next lngZeile_3
  End With
  
  'Arrays leeren
  Erase arrWerte2, arrDatum2, arrDatum3
  Application.ScreenUpdating = True
  MsgBox "Fertig" & vbLf & "Start: " & datStart & vbLf & "Ende:  " & Time
Beenden:
  With Application
    .StatusBar = False
    .ScreenUpdating = True
    .Calculation = StatusCalc
  End With
End Sub
Besten Dank für eine Hilfe!
mfg

Bild

Betrifft: AW: Code anpassen (Original von fcs)
von: Matthias
Geschrieben am: 31.08.2015 08:10:07
Hallo erichm,
dann setze doch deine Variable auf die Spaltennummer von "AZ" fest, statt sie mit dem fettgedruckten Ausdruck zu ermitteln.
"SpalteL = 52"
lg Matthias

Bild

Betrifft: AW: Code anpassen (Original von fcs)
von: erichm
Geschrieben am: 31.08.2015 08:17:00
DANKE - das fettgedruckte war nur, damit die User den Teil in diesem Bereich schneller finden.
Werde das testen und melde mich (abends) wieder.
mfg

Bild

Betrifft: AW: Code anpassen (Original von fcs)
von: Matthias
Geschrieben am: 31.08.2015 08:35:46
Falls nicht immer alle Spalten bis AZ ausgefüllt sein müssen, kannst du um Ressourcen zu sparen auch folgendes machen:

With wks3
SpalteL = .Cells(3, .Columns.Count).End(xlToLeft).Column
If SpalteL >52 Then SpalteL = 52
ZeileL = .Cells(.Rows.Count, 1).End(xlUp).Row
'...
Damit hast du die gleiche Funktionsweise wie bisher und deine Spalte kann nicht größer als 52 werden.
lg Matthias

Bild

Betrifft: AW: Code anpassen (Original von fcs)
von: erichm
Geschrieben am: 31.08.2015 22:02:24
DANKE - funktioniert und diese Lösung ist optimal!!
mfg

 Bild

Beiträge aus den Excel-Beispielen zum Thema "Code anpassen (Original von fcs)"