10.11.2023, 12:02
naja, mein Ziel ist es die Komminikationsobjekte KO die cih für die ETS (KNX-Parametrierung) benötige automatisch erzeugen zu lassen.
Das werden mehre Hundert die alle per Hand eingetragen werden müssten.
Mit der Excel sollte es mir gelingen, für jedes Gerät das ich eingebe die nötigen KOs erzeugen zu lassen.
Anschließend werden alle KOs in eine csv geschrieben und können dann in die ETS eingelesen werden.
Und der andere Grund, ich sehe es als Gehirnjogging. Ich bin 50 und versuche Lösungen zu finden um mein Gehirn fitt zu halten.
Außerdem möchte ich mein Haus automatiesieren und mach dann alles händisch... wäre irgendwie komisch
ich musste noch enige sachen in den tabellen ändern, da es Probleme mit Leerzeichen und Sonderzeichen gab Aber so werden mir die Kürzel für die Kos schon einmal angezeigt...
Das werden mehre Hundert die alle per Hand eingetragen werden müssten.
Mit der Excel sollte es mir gelingen, für jedes Gerät das ich eingebe die nötigen KOs erzeugen zu lassen.
Anschließend werden alle KOs in eine csv geschrieben und können dann in die ETS eingelesen werden.
Und der andere Grund, ich sehe es als Gehirnjogging. Ich bin 50 und versuche Lösungen zu finden um mein Gehirn fitt zu halten.
Außerdem möchte ich mein Haus automatiesieren und mach dann alles händisch... wäre irgendwie komisch
Code:
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim iZeile&: iZeile = Target.Cells.Row
Dim laenge1 As Long
Dim Gewerk As String
Dim Kategory As String
Dim GA As String
Dim tabHG As Range
Dim tabMG As Range
Dim tabUG As Range
Dim i&, j As Range
Dim UG As String
If Target = "" Then Exit Sub
If Application.WorksheetFunction.CountIf(Columns(2), Target) > 1 Then
MsgBox "Wert schon vorhanden"
Application.Undo
Exit Sub
ElseIf Application.WorksheetFunction.CountIf(Worksheets("Raumbuch").Columns(15), Target) = 0 Then
MsgBox "Wert ungültig"
Application.Undo
Exit Sub
End If
'auslesen Gewerk
Gewerk = Cells(iZeile, 6)
MsgBox "Wert gültig" & iZeile & Gewerk
'auslesen aller zum Gewerk gehörenden HG
For Each tabHG In Worksheets(5).Range(Gewerk)
If tabHG <> "" Then 'leere Zellen ausschließen
Kategorie = Cells(iZeile, 7)
'MsgBox "HG: " & tabHG & " " & Kategorie
'auslesen aller MG zu HG
For Each tabMG In Worksheets(5).Range(tabHG)
If tabMG <> "" Then 'leere Zellen ausschließen
'MsgBox "MG: " & tabMG
'auslesen der Untergruppen
For Each tabUG In Worksheets(5).Range(Kategorie)
If tabMG = Tabelle8.Cells(tabUG.Cells.Row, 2) And tabUG.Value2 = True Then 'nur KO erzeugen wenn UG auf "WAHR"
i = tabUG.Cells.Row
GA = Tabelle8.Cells(i, 3)
MsgBox "GA: ..." & GA
End If
Next tabUG
End If
Next tabMG
End If
Next tabHG
End Subich musste noch enige sachen in den tabellen ändern, da es Probleme mit Leerzeichen und Sonderzeichen gab Aber so werden mir die Kürzel für die Kos schon einmal angezeigt...