26. september 2013 - 12:20
Der er
1 løsning
2-dimensional array
Hej Eksperter,
Jeg har to 2-dimensional arrays - Array1(1,2) og Array2(5,2). Dvs. Array1 er en record og Array2 er en table med records. Jeg ønsker at tilføje records til tablen.
Betingelsen er at tilføje Array1 til Array2, kun såfremt først kollonne som er nøgle ikke er i Array2 i forvejen. Er den i Array2 skal Array2 overskrives med værdierne fra Array1 for den givne record.
Det hele skal ske i VBA og kun med en læsning fra worksheet range og en skrivning til worksheet range.
Eksempel:
Array1:
Grp CurrentPlan
G 10
Array2:
Grp CurrentPlan
F 1
B 2
C 3
Resultat i Array2
Array2:
Grp CurrentPlan
F 1
B 2
C 3
G 10
30. september 2013 - 20:46
#1
Prøv engang at kigge på denne kode, og se om du efterfølgende kan få hul igennem din egen kode...
Sub ArrayDemo()
Dim aSource As Variant, aTarget As Variant
Dim iLastTarget As Integer, iNewMax As Integer
Dim x As Integer, y As Integer
' Opret et target array 3,2 med indhold
ReDim aTarget(1 To 3, 1 To 2)
aTarget(1, 1) = "Allan"
aTarget(1, 2) = "1"
aTarget(2, 1) = "Bente"
aTarget(2, 2) = "2"
aTarget(3, 1) = "Casper"
aTarget(3, 2) = "3"
' Opret et source array 1,2 med indhold
ReDim aSource(1 To 1, 1 To 2)
aSource(1, 1) = "Doris"
aSource(1, 2) = "4"
' Udvid target array så alt fra source array kan fyldes deri
iLastTarget = UBound(aTarget, 1)
iNewMax = iLastTarget + UBound(aSource, 1)
' Et to demintionelt array kan ikke udvides i første demintion, men kun i den anden,
' derfor må array'et vendes rundt, udvides og vendes tilbage igen
aTarget = TransposeArray(aTarget) ' byt om
ReDim Preserve aTarget(1 To 2, 1 To iNewMax) ' udvid
aTarget = TransposeArray(aTarget) ' byt retur
' Indsæt nye værdier
For x = LBound(aSource, 1) To UBound(aSource, 1)
For y = LBound(aSource, 2) To UBound(aSource, 2)
aTarget(iLastTarget + x, y) = aSource(x, y)
Next y
Next
'Indsæt værdier i aktivt ark
ActiveSheet.Range("A1").Resize(UBound(aTarget, 1), UBound(aTarget, 2)).Value = aTarget
End Sub
Public Function TransposeArray(ByVal aSource As Variant) As Variant
Dim aRetVal As Variant
Dim lRow As Long, lCol As Long
ReDim aRetVal(LBound(aSource, 2) To UBound(aSource, 2), LBound(aSource, 1) To UBound(aSource, 1))
For lRow = LBound(aSource, 1) To UBound(aSource, 1)
For lCol = LBound(aSource, 2) To UBound(aSource, 2)
aRetVal(lCol, lRow) = aSource(lRow, lCol)
Next lCol
Next lRow
TransposeArray = aRetVal
End Function
