Complie error: Only user-defined types ....
02.07.2024 22:41:53
Ralf Oldenhage
ich komme einfach nicht weiter mit einer Fehlermeldung die ich nicht verstehe. Bei google und MS finde ich nichts und ChatGPT ist auch primär artificial und wenig intelligent in diesem Fall.
Hier mein Code, sorry ist etwas lang, aber da ich keine Ahnung hab wo ich anfangen soll poste ich es lieber mal ganz inclusive der "Type Deklarationen"
Sobald ich das script unten starten will bzw. F8 drücke bekomme ich:
Compile error: "Only user-defined types defined in public object modules can be coerced to and from a variant or passed to late-bound functions."
Dabei spring der debugger in diesem Block:
' Check if key exists in dictArtLoc, if not, add newData
If Not dictArtLoc.exists(keyArtLoc) Then
dictArtLoc(keyArtLoc) = newData
End If
auf "newData"
Option Explicit
Type DataPower
Art As String
Ops As Long
FlexSds As Long
AssqSds As Long
End Type
Type DataFMS
Art As String
Loc As String
Descr As String
SceMin As Long
SceMax As Long
SceMpq As Long
ScePalq As Long
ScePrim As Boolean
End Type
Type dataSLM
Art As Variant
Loc As Variant
Div As Variant
SSQ As Variant
Flex As Variant
SlmPrim As Variant
ProdDom As Variant
ComQ As Variant
End Type
Type MergedDataType
Art As Variant
Loc As Variant
Div As Variant
SSQ As Variant
Flex As Variant
SlmPrim As Variant
ProdDom As Variant
ComQ As Variant
Descr As Variant
SceMin As Variant
SceMax As Variant
SceMpq As Variant
ScePalq As Variant
ScePrim As Variant
Ops As Variant
FlexSds As Variant
AssqSds As Variant
End Type
Sub HandleInUDTs()
Dim wsPowerBI As Worksheet, wsFMS As Worksheet, wsSLM As Worksheet, wsResult As Worksheet
Dim dtPowerBI() As DataPower, dtFMS() As DataFMS, dtSLM() As dataSLM, dtResult() As MergedDataType
Dim i As Long, j As Long, k As Long
Dim dictArtLoc As Object, dictArtOnly As Object
Dim keyArtLoc As String, keyArtOnly As String
' Set worksheets
Set wsSLM = ThisWorkbook.Sheets("SLM")
Set wsFMS = ThisWorkbook.Sheets("FMS")
Set wsPowerBI = ThisWorkbook.Sheets("PowerBI")
Set wsResult = ThisWorkbook.Sheets("Merge")
' Lese Daten in Arrays
Dim lastRowSLM As Long, lastRowFMS As Long, lastRowPowerBI As Long
lastRowSLM = wsSLM.Cells(wsSLM.Rows.Count, "A").End(xlUp).Row
lastRowFMS = wsFMS.Cells(wsFMS.Rows.Count, "A").End(xlUp).Row
lastRowPowerBI = wsPowerBI.Cells(wsPowerBI.Rows.Count, "A").End(xlUp).Row
ReDim dtSLM(1 To lastRowSLM - 1)
ReDim dtFMS(1 To lastRowFMS - 1)
ReDim dtPowerBI(1 To lastRowPowerBI - 1)
' Read data into arrays
For i = 2 To lastRowSLM
With wsSLM
dtSLM(i - 1).Art = .Cells(i, 2).Value
dtSLM(i - 1).Loc = .Cells(i, 3).Value
dtSLM(i - 1).Div = .Cells(i, 4).Value
dtSLM(i - 1).SSQ = .Cells(i, 5).Value
dtSLM(i - 1).Flex = .Cells(i, 6).Value
dtSLM(i - 1).SlmPrim = .Cells(i, 7).Value
dtSLM(i - 1).ProdDom = .Cells(i, 8).Value
dtSLM(i - 1).ComQ = .Cells(i, 9).Value
End With
Next i
For i = 2 To lastRowFMS
With wsFMS
dtFMS(i - 1).Art = .Cells(i, 1).Value
dtFMS(i - 1).Loc = .Cells(i, 2).Value
dtFMS(i - 1).Descr = .Cells(i, 3).Value
dtFMS(i - 1).SceMin = .Cells(i, 4).Value
dtFMS(i - 1).SceMax = .Cells(i, 5).Value
dtFMS(i - 1).SceMpq = .Cells(i, 6).Value
dtFMS(i - 1).ScePalq = .Cells(i, 7).Value
dtFMS(i - 1).ScePrim = .Cells(i, 8).Value
End With
Next i
For i = 2 To lastRowPowerBI
With wsPowerBI
dtPowerBI(i - 1).Art = .Cells(i, 1).Value
dtPowerBI(i - 1).Ops = .Cells(i, 2).Value
dtPowerBI(i - 1).FlexSds = .Cells(i, 3).Value
dtPowerBI(i - 1).AssqSds = .Cells(i, 4).Value
End With
Next i
' Initialize dictionaries
Set dictArtLoc = CreateObject("Scripting.Dictionary")
Set dictArtOnly = CreateObject("Scripting.Dictionary")
' Process SLM data
For i = LBound(dtSLM) To UBound(dtSLM)
keyArtLoc = dtSLM(i).Art & "|" & dtSLM(i).Loc
keyArtOnly = dtSLM(i).Art
' Initialize newData for each loop iteration
Dim newData As MergedDataType
With newData
.Art = dtSLM(i).Art
.Loc = dtSLM(i).Loc
.Div = dtSLM(i).Div
.SSQ = dtSLM(i).SSQ
.Flex = dtSLM(i).Flex
.SlmPrim = dtSLM(i).SlmPrim
.ProdDom = dtSLM(i).ProdDom
.ComQ = dtSLM(i).ComQ
End With
' Check if key exists in dictArtLoc, if not, add newData
If Not dictArtLoc.exists(keyArtLoc) Then
dictArtLoc(keyArtLoc) = newData
End If
' Check if key exists in dictArtOnly, if not, add newData
If Not dictArtOnly.exists(keyArtOnly) Then
dictArtOnly(keyArtOnly) = newData
End If
Next i
' Process FMS data
For i = LBound(dtFMS) To UBound(dtFMS)
keyArtLoc = dtFMS(i).Art & "|" & dtFMS(i).Loc
keyArtOnly = dtFMS(i).Art
' Check if key exists in dictArtLoc, update existingData if found
If dictArtLoc.exists(keyArtLoc) Then
Dim existingData As MergedDataType
existingData = dictArtLoc(keyArtLoc)
existingData.Descr = dtFMS(i).Descr
existingData.SceMin = dtFMS(i).SceMin
existingData.SceMax = dtFMS(i).SceMax
existingData.SceMpq = dtFMS(i).SceMpq
existingData.ScePalq = dtFMS(i).ScePalq
existingData.ScePrim = dtFMS(i).ScePrim
dictArtLoc(keyArtLoc) = existingData
ElseIf dictArtOnly.exists(keyArtOnly) Then
Dim existingData As MergedDataType
existingData = dictArtOnly(keyArtOnly)
existingData.Descr = dtFMS(i).Descr
existingData.SceMin = dtFMS(i).SceMin
existingData.SceMax = dtFMS(i).SceMax
existingData.SceMpq = dtFMS(i).SceMpq
existingData.ScePalq = dtFMS(i).ScePalq
existingData.ScePrim = dtFMS(i).ScePrim
dictArtOnly(keyArtOnly) = existingData
Else
' If key doesn't exist in dictArtLoc or dictArtOnly, add newData
Dim newData As MergedDataType
With newData
.Art = dtFMS(i).Art
.Loc = dtFMS(i).Loc
.Descr = dtFMS(i).Descr
.SceMin = dtFMS(i).SceMin
.SceMax = dtFMS(i).SceMax
.SceMpq = dtFMS(i).SceMpq
.ScePalq = dtFMS(i).ScePalq
.ScePrim = dtFMS(i).ScePrim
End With
dictArtLoc(keyArtLoc) = newData
dictArtOnly(keyArtOnly) = newData
End If
Next i
' Process PowerBI data
For i = LBound(dtPowerBI) To UBound(dtPowerBI)
keyArtOnly = dtPowerBI(i).Art
' Check if key exists in dictArtOnly, update existingData if found
If dictArtOnly.exists(keyArtOnly) Then
Dim existingData As MergedDataType
existingData = dictArtOnly(keyArtOnly)
existingData.Ops = dtPowerBI(i).Ops
existingData.FlexSds = dtPowerBI(i).FlexSds
existingData.AssqSds = dtPowerBI(i).AssqSds
dictArtOnly(keyArtOnly) = existingData
Else
' If key doesn't exist in dictArtOnly, add newData
Dim newData As MergedDataType
With newData
.Art = dtPowerBI(i).Art
.Ops = dtPowerBI(i).Ops
.FlexSds = dtPowerBI(i).FlexSds
.AssqSds = dtPowerBI(i).AssqSds
End With
dictArtOnly(keyArtOnly) = newData
End If
Next i
' Write result to the result sheet
Dim resultRow As Long
resultRow = 2 ' Start row for results
For Each keyArtLoc In dictArtLoc
With wsResult
.Cells(resultRow, 1).Value = dictArtLoc(keyArtLoc).Art
.Cells(resultRow, 2).Value = dictArtLoc(keyArtLoc).Loc
.Cells(resultRow, 3).Value = dictArtLoc(keyArtLoc).Div
.Cells(resultRow, 4).Value = dictArtLoc(keyArtLoc).SSQ
.Cells(resultRow, 5).Value = dictArtLoc(keyArtLoc).Flex
.Cells(resultRow, 6).Value = dictArtLoc(keyArtLoc).SlmPrim
.Cells(resultRow, 7).Value = dictArtLoc(keyArtLoc).ProdDom
.Cells(resultRow, 8).Value = dictArtLoc(keyArtLoc).ComQ
.Cells(resultRow, 9).Value = dictArtLoc(keyArtLoc).Descr
.Cells(resultRow, 10).Value = dictArtLoc(keyArtLoc).SceMin
.Cells(resultRow, 11).Value = dictArtLoc(keyArtLoc).SceMax
.Cells(resultRow, 12).Value = dictArtLoc(keyArtLoc).SceMpq
.Cells(resultRow, 13).Value = dictArtLoc(keyArtLoc).ScePalq
.Cells(resultRow, 14).Value = dictArtLoc(keyArtLoc).ScePrim
.Cells(resultRow, 15).Value = dictArtLoc(keyArtLoc).Ops
.Cells(resultRow, 16).Value = dictArtLoc(keyArtLoc).FlexSds
.Cells(resultRow, 17).Value = dictArtLoc(keyArtLoc).AssqSds
End With
resultRow = resultRow + 1
Next keyArtLoc
End Sub
irgend eine Idee was ich noch machen könnte?
Vielen Dank für Hinweise. Ralf
Anzeige