HERBERS Excel-Forum - das Archiv
Code anpassen (Original von fcs)
fcs)

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

AW: Code anpassen (Original von fcs)
fcs)

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

AW: Code anpassen (Original von fcs)
fcs)

DANKE - das fettgedruckte war nur, damit die User den Teil in diesem Bereich schneller finden.
Werde das testen und melde mich (abends) wieder.
mfg

AW: Code anpassen (Original von fcs)
fcs)

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

AW: Code anpassen (Original von fcs)
fcs)

DANKE - funktioniert und diese Lösung ist optimal!!
mfg

Code anpassen (Original von fcs)
fcs)

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

AW: Code anpassen (Original von fcs)
fcs)

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

AW: Code anpassen (Original von fcs)
fcs)

DANKE - das fettgedruckte war nur, damit die User den Teil in diesem Bereich schneller finden.
Werde das testen und melde mich (abends) wieder.
mfg

AW: Code anpassen (Original von fcs)
fcs)

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

AW: Code anpassen (Original von fcs)
fcs)

DANKE - funktioniert und diese Lösung ist optimal!!
mfg

Bewerten Sie hier bitte das Excel-Portal