AW: nochmal etwas genauer...
23.03.2015 13:55:18
UweD
Hallo
da sieht man wieder wie wichtig es ist, "echte Daten" zu liefern.
In deinen ersten Fragen hast du von 2 Mappen mit je einer Tabelle mit Min bzw. Max gesprochen
Jetzt ist es nur eine Mappe aber mit 2 Tabellen
im ursprünglichen Bild begannen die Werte in Spalte B, Spalte A konnte also weggelassen werden
Jetzt hast du in den Ursprungsdaten Spalte A schon weggenommen..
Ich hab mein ursprüngliches Makro daraufhin nochmal angepasst.
ABER in Zeile 383 stimmen die Werte in Min bzw. Max nicht mehr überein.
Ab da sind die zugehörenden Minwerte eine Zeile tiefer.
Dein Beispiel kann nicht aus diesen beiden Werten entstanden sein.
Lösche ich Zeile 383 in der Mintabelle stimmen die errechneten Werte des Makros mit deinem Beispiel überein. (ausser bei den Alpen... Also ist hier irgend was in der Tabelle falsch )
Option Explicit
Sub MaxMax()
On Error GoTo Fehler
Dim Pfad$, TB1, TB2, TB3, i%, j&, s%, r&
Dim WB2$, LR2&, LC2%
Pfad = "C:\Temp\" 'anpassen
WB2 = "Min_Max.xlsx" 'anpassen
Application.ScreenUpdating = False
Set TB1 = ActiveWorkbook.ActiveSheet
Workbooks.Open Filename:=Pfad & WB2
Set TB2 = Workbooks(WB2).Sheets("oGBIF_per_Polygon_Crosstab_min")
Set TB3 = Workbooks(WB2).Sheets("oGBIF_per_Polygon_Crosstab_max")
LC2 = TB2.Cells(1, Columns.Count).End(xlToLeft).Column
s = 1: r = 1
With TB1
.Cells.Clear
.Rows(1).Font.Bold = True
For i = 1 To LC2 ' Spaltenweise
LR2 = TB2.Cells(Rows.Count, i).End(xlUp).Row
For j = 1 To LR2
If TB2.Cells(j, i) "" Then
.Cells(r, s + 1) = TB2.Cells(j, i) 'aus Min
If j > 1 Then .Cells(r, s + 2) = TB3.Cells(j, i) 'aus Max
If j = 2 Then .Cells(r, s) = "Max_neu"
If j > 2 Then .Cells(r, s) = IIf(TB3.Cells(j, i) - TB2.Cells(j, i) > 0, _
TB3.Cells(j, i), TB3.Cells(j, i) + 1)
r = r + 1
End If
Next j
r = 1
s = s + 3
Next i
.Cells(1, 1).Delete Shift:=xlToLeft
End With
Workbooks(WB2).Close
'*** Fehlerbehandlung
Err.Clear
Fehler:
If Err.Number 0 Then MsgBox "Fehler: " & Err.Number & vbLf & Err.Description: Err. _
Clear
End Sub
Gruß UweD
Rückmeldung wäre nett
