Thema: Fehler 2015

Hallo.
Ich habe vom Kollegen (der leider ausgeschieden ist) eine Excel Tabelle (aktuelle Version) mit einem VBA-Script übernommen. Das Script soll die 3 niedrigsten Preise einer Matrix farblich markieren, und zwar nach einem aufsteigenden Prinzip (den kleinsten Preis "grün" dann "gelb" und anschl. "rot").
Es sind 4 verschiedene Bereiche, welche alle gleich aussehen. Die Zahlen in "schwarz" sind Grundpreise, welche nicht beachtet werden sollen. Nur die Zahlen in "blau" sollen verglichen werden. Diese ergeben sich aus Addition des Grundwertes und verschiedener zusätzlicher Werte. Jeden Monat ändern sich die "blauen" Werte und sind somit immer unterschiedlich. Die erste Zelle (Zahl 585,00 €) in der u.a. Tabelle ist F10. Hier ein Beispiel.



Im Objekt ist folgender Code hinterlegt:
Private Sub Worksheet_Change(ByVal Target As Range)
' Call the ApplyHighlightCode subroutine with the Target argument to update highlights
ApplyHighlightCode Target
End Sub
Private Sub Workbook_Open()
Application.EnableEvents = True
End Sub

Als Module folgender Code:
' Module1 - This is a public module
Sub ApplyCodeToWorksheets()
' Apply the code to the "Test" worksheet
ApplyHighlightCode ThisWorkbook.Sheets("Test").Range("A1")
' Add more worksheets as needed
' ApplyHighlightCode ThisWorkbook.Sheets("AnotherWorksheet").Range("A1")
End Sub
Sub ApplyHighlightCode(Target As Range)
' Extract the worksheet from the Target range
Dim ws As Worksheet
Set ws = Target.Worksheet
' Define the ranges for each worksheet
Dim rng1 As String, rng2 As String, rng3 As String, rng4 As String
' Define the ranges for the specific worksheet
Select Case ws.Name

Case "Test"
rng1 = "F10:AC43"
rng2 = "F55:AC88"
rng3 = "AJ10:BE43"
rng4 = "AJ55:BE88"

' Add more cases for other worksheets as needed
End Select
' Define the union of ranges
Dim rng As Range
Set rng = Union(ws.Range(rng1), ws.Range(rng2), ws.Range(rng3), ws.Range(rng4))
Application.ScreenUpdating = False ' Disable screen updating for faster execution
' Clear previous highlights
rng.Interior.ColorIndex = xlNone
For Each Row In rng.Rows
' Initialize variables to keep track of the lowest, second lowest, and third lowest values for the current row
lowestValue = 0
secondLowestValue = 0
thirdLowestValue = 0
' Initialize variables to keep track of the cells containing the lowest, second lowest, and third lowest values
Set lowestCell = Nothing
Set secondLowestCell = Nothing
Set thirdLowestCell = Nothing
' Populate the array with row values
valuesArray = Row.Value
' Loop through each cell in the current row
For j = 1 To UBound(valuesArray, 2)
' Get the entire column name (e.g., "F", "G", "AH")
Dim columnName As String
columnName = Split(Row.Cells(1, j).Address, "$")(1)
' Check if the entire column name is in the list of excluded columns
If Not IsExcludedColumn(columnName) Then
' Check if the value is numeric and greater than 1
If IsNumeric(valuesArray(1, j)) And valuesArray(1, j) > 1 Then
' Compare the value to the current lowest, second lowest, and third lowest values
If valuesArray(1, j) < lowestValue Or lowestValue = 0 Then
thirdLowestValue = secondLowestValue
Set thirdLowestCell = secondLowestCell
secondLowestValue = lowestValue
Set secondLowestCell = lowestCell
lowestValue = valuesArray(1, j)
Set lowestCell = Row.Cells(1, j)
ElseIf valuesArray(1, j) < secondLowestValue Or secondLowestValue = 0 Then
thirdLowestValue = secondLowestValue
Set thirdLowestCell = secondLowestCell
secondLowestValue = valuesArray(1, j)
Set secondLowestCell = Row.Cells(1, j)
ElseIf valuesArray(1, j) < thirdLowestValue Or thirdLowestValue = 0 Then
thirdLowestValue = valuesArray(1, j)
Set thirdLowestCell = Row.Cells(1, j)
End If
End If
End If
Next j
' Apply formatting to the cells with the lowest, second lowest, and third lowest values
If Not lowestCell Is Nothing Then lowestCell.Interior.Color = RGB(147, 237, 135) ' Red
If Not secondLowestCell Is Nothing Then secondLowestCell.Interior.Color = RGB(255, 255, 0) ' Yellow
If Not thirdLowestCell Is Nothing Then thirdLowestCell.Interior.Color = RGB(252, 192, 200) ' Green
Next Row
Application.ScreenUpdating = True ' Re-enable screen updating
End Sub
' Function to check if a column should be excluded
Function IsExcludedColumn(columnName As String) As Boolean
Dim excludedColumns As String
excludedColumns = "F,H,J,L,N,P,R,T,V,X,Z,AB,AD,AE,AF,AG,AH,AI,AJ,AL,AN,AP,AR,AT,AV,AX,AZ,BB,BD,BF,BH,BJ"
' Check if the columnName is in the list of excluded columns
IsExcludedColumn = InStr(1, excludedColumns, columnName, vbTextCompare) > 0
End Function

Seit dem die Tabelle etwas ergänzt wurde, funktioniert das Script nicht mehr richtig.
Beim Ausführen des Scriptes kommt ein Fehler und beim debbugen wir in folgender Zeile
If IsNumeric(valuesArray(1, j)) And valuesArray(1, j) > 1 Then
der Fehler angezeigt:
valuesArray(1, j) = Fehler 2015

Ich hoffe, ich habe alles Nötige geschildert. Falls noch etwas gebraucht wird, bitte fragen.
Hat vielleicht jemand eine Idee.
Vielen Dank für die Hilfe.
VG
Johnny

Hallo,

die Prüfungen müssen getrennt erfolgen:

If IsNumeric(valuesArray(1, j)) Then

  If valuesArray(1, j) > 1 Then

    '... der Code

  End If

End If

Beachte, dass ein zusätzliches End If eingefügt werden muss.

Gruß, Uwe

Hi,

zeig bitte per Upload eine Excel-Bsp-Datei mit genügend Bsp-Daten und deinem Code.
Excel war nie, ist nicht und wird nie ein Programm für Bildbearbeitung sein - deswegen sind nur Bilddateien nur ganz, ganz selten (fast nie) hilfreich.
Außerdem....mit ner Excel-Datei können wir doch viel besser testen, oder? Bisher können wir mehr oder weniger (auf jeden Fall mehr als weniger) nur raten.

Ciao
Thorsten

Anbei die Tabelle inkl. Script

https://www.herber.de/bbs/user/168484.xlsx

Bitte um Hilfe

Du hast dich bedankt, aber ist das Thema denn erledigt?

Ich bin jedenfalls der Meinung, dass das nicht funktionieren konnte, denn
wenn nach beispielsweise Spalte "G" gesucht wurde, dann hat Instr natürlich G gefunden, wegen Spalte AG gefunden und die Spalte G ignoriert.
Ich habe das jetzt so gelöst, dass nach ",G," gesucht wird, dazu muss halt am Anfang und am Ende der Liste auch ein Komma sein.
Vermutlich hat da einer ergänzt, zuvor waren vermutlich nicht so viele Spalten angegeben, sonst hätte das ja nie funktioniert.

' Function to check if a column should be excluded

Function IsExcludedColumn(columnName As String) As Boolean

Dim excludedColumns As String

excludedColumns = ",F,H,J,L,N,P,R,T,V,X,Z,AB,AD,AE,AF,AG,AH,AI,AJ,AL,AN,AP,AR,AT,AV,AX,AZ,BB,BD,BF,BH,BJ,"

' Check if the columnName is in the list of excluded columns

IsExcludedColumn = InStr(1, excludedColumns, "," & columnName & ",", vbTextCompare) > 0

End Function

Hallo Oppawinni.

Das funktioniert jetzt einwandfrei.
Vielen Dank.

VG
Johnny

Super dass du im VBA Forum auch Bescheid gesagt hast dass das Thema gelöst wurde.

bhh.

Vielen Dank Uwe.

Der Fehler ist weg, jedoch werden die Werte immer noch nicht richtig markiert.



Bitte um Hilfe.

Danke.
VG
Johnny

Du sollst halt auch nicht mit dem Textmarker auf dem Bildschirm herum malen.
Sorry, aber den konnte ich mir jetzt nicht verkneifen.
Deine Bildchen sind ja schön, aber wenn du das entscheidende übermalst hilft das schon gar nicht.
Eine Beispieldatei wäre viel nützlicher.

In der markierten Zeile ist zu erkennen, dass der kleinste Wert (882,19 €) in der 2ten Spalte steht.
Dieser wird jedoch nicht markiert, sondern der Wert (906,27 €) aus der 8ten Spalte, welcher höher ist.

Man weiß ja dann auch nicht, um welche Spalten es sich handelt.
Es gibt ja in dem Code Spalten, die von der Prüfung ausgenommen sind.
Das hilft so überhaupt nichts.

Nachdem die vom Makro bearbeiteten Ranges mit
rng1 = "F10:AC43"
rng2 = "F55:AC88"
rng3 = "AJ10:BE43"
rng4 = "AJ55:BE88"
definiert sind, brauchte man Spalten außerhalb dieser Bereich nicht explizit auszuschließen.
Spalten AD, AE, AF, AG liegen nicht in den Bereichen, müssten also in "excludedColumns" nicht auftauchen.
Damit wäre das Problem, dass Spalte "G" in "AG" gefunden, also ausgeschlossen wird, auch nicht aufgetreten.
Dennoch ist es natürlich sinnvoll die Suche so gestallten, dass derartige Fehler nicht auftreten können.

' Function to check if a column should be excluded

Function IsExcludedColumn(columnName As String) As Boolean

Dim excludedColumns As String

excludedColumns = ",F,H,J,L,N,P,R,T,V,X,Z,AB,AJ,AL,AN,AP,AR,AT,AV,AX,AZ,BB,BD,"

' Check if the columnName is in the list of excluded columns

IsExcludedColumn = InStr(1, excludedColumns, "," & columnName & ",", vbTextCompare) > 0

End Function