Headezimaldaten bearbeiten

Hallo Zusammen,
ich habe eine Nuß zu knacken, bei der ich eure Hilfe brauche.
Es geht darum, dass Daten aus einem Hexadezimal Datenfeld in ein anderes kopiert werden sollen.
Die Datenfelfer (Quelle und Ziel) sind exakt gleich groß (16x65533). Beide sind in ein Excel Datenblatt nebeneinander eingeladen.
Das Ziel des zu erstellenden Makros ist, Daten (einzelne Zellen oder auch mehrere Daten hintereinander) aus der Quelldatei in die Zieldatei zu kopieren. Die Datenpakete sind bei Quell- und Zieldatei an unterschiedlichen Stellen untergebracht. Es existiert eine Übersicht der Datenpakete (=Variablen) die die Anfangsadresse angibt sowie die Größe der aufeinanderfolgenden Werte (=Zellen).
Die zu kopierenden Daten können in der Tabelle durch ein "X" ausgewählt werden; X bedeutet also dass diese Variable kopiert werden muss.
Das Makro sollte also die Tabelle durchgehen dort die Adressen in der Quelldatei lesen, die Daten aus der Quelldatei kopieren, die Zieladresse lesen und an der Zieldatei die kopierten Werte einfügen.
Ich habe in der zweiten Spalte bzw. ersten Zeile die Spalten- bzw Zeilen adressen im Hex Format angegben (dachte das hilft velleicht). Vielleicht ist das auch unnötig und jemand weiß wie man direkt mit der Gesamtadresse arbeitet. Ich weiß es leider nicht :-)
Ich hoffe es kann mir jemand helfen, ich verzweifle so langsam an der Aufgabe :-)
Fanke & Gruß
Greg

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Option Explicit Sub VarKop() Dim lngQ As Long, arQ, qr As Long, qc As Long Dim nn As Long, zr As Long, zc As Long Dim lngA As Long, arA, aa As Long lngQ = Cells(Rows.Count, 1).End(xlUp).Row - 2 arQ = Cells(3, 3).Resize(lngQ, 16) lngA = Cells(Rows.Count, 37).End(xlUp).Row - 2 arA = Cells(3, 37).Resize(lngA, 8) For aa = 1 To lngA If arA(aa, 1) = "X" Then nn = 0 qr = CLng("&H" & Left(arA(aa, 5), Len(arA(aa, 5)) - 1)) qc = CLng("&H" & Right(arA(aa, 5), 1)) zr = CLng("&H" & Left(arA(aa, 8), Len(arA(aa, 8)) - 1)) zc = CLng("&H" & Right(arA(aa, 8), 1)) Do While nn 15 Then zc = 0: zr = zr + 1 qc = qc + 1 If qc > 15 Then qc = 0: qr = qr + 1 nn = nn + 1 Loop End If Next aa End Sub

Hi Greg,
der von mir gepostete Code enthielt noch ein paar völlig nutzlose Zeilen (die mit lngQ und arQ).
In der heutigen Version sind die eliminiert.
Nachteil des Codes ist, dass dabei der Wert jeder Zelle einzeln übertragen wird. Das ergibt sehr viele Änderungen
im Tabellenblatt. Geschickter und schneller ist die blockweise Übertragung der Werte von rechteckigen Zellbereichen.
Das passierr in der Prozedur VarKop2().


Sub VarKop()
Dim lngA As Long, arA, aa As Long
Dim qr As Long, qc As Long, nn As Long, zr As Long, zc As Long
lngA = Cells(Rows.Count, 37).End(xlUp).Row - 2
arA = Cells(3, 37).Resize(lngA, 8)
'  ActiveSheet.UsedRange.Interior.ColorIndex = xlColorIndexNone
For aa = 1 To lngA
If arA(aa, 1) = "X" Then
nn = 0
qr = CLng("&H" & Left(arA(aa, 5), Len(arA(aa, 5)) - 1))
qc = CLng("&H" & Right(arA(aa, 5), 1))
zr = CLng("&H" & Left(arA(aa, 8), Len(arA(aa, 8)) - 1))
zc = CLng("&H" & Right(arA(aa, 8), 1))
Do While nn  15 Then zc = 0: zr = zr + 1
qc = qc + 1
If qc > 15 Then qc = 0: qr = qr + 1
nn = nn + 1
Loop
End If
Next aa
End Sub
Sub VarKop2()
Dim lngA As Long, arA, aa As Long, ff As Long, ffa
Dim arE() As Long, xMin As Long
Dim dqv As Long, dqb As Long, dzv As Long, rqb As Long, cqb As Long
Dim qr As Long, zr As Long, qc As Long, zc As Long
Dim ii As Long, jj As Long
Dim nachR As Long, nachU As Long
lngA = Cells(Rows.Count, 37).End(xlUp).Row - 2
arA = Cells(3, 37).Resize(lngA, 8)
ffa = Array(38, 4, 36, 8, 24, 44)
'  ActiveSheet.UsedRange.Interior.ColorIndex = xlColorIndexNone
For aa = 1 To lngA
If arA(aa, 1) = "X" Then
ReDim arE(arA(aa, 4) - 1)
For ii = 0 To arA(aa, 4) - 1
arE(ii) = ii
Next ii
dqv = CLng("&H" & arA(aa, 5))
dqb = dqv + arA(aa, 4)
dzv = CLng("&H" & arA(aa, 8))
rqb = Fix(dqb / 16)
cqb = dqb Mod 16
xMin = Application.Min(arE)
Do While xMin

Rückmeldung wäre nett! - Grüße aus Kamp-Lintfort von Erich

Beliebteste Forumthreads (12 Monate)

17 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

17
Beiträge zum Forumthread

Beiträge zu diesem Forumthread