Zellen auslesen

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Sub test() Dim oDic As Object, meAr(1), strString$ Dim A As Long Set oDic = CreateObject("Scripting.Dictionary") 'Tabellennamen anpassen !!!!!!!!!!!!!!! meAr(0) = Sheets("Tabelle1").Range("AH4:AH77").Value2 For A = 1 To Ubound(meAr(0)) If meAr(0)(A, 1) <> "" Then If oDic.exists(meAr(0)(A, 1)) Then oDic(meAr(0)(A, 1)) = Union(Range(oDic(meAr(0)(A, 1))), Range("AH" & 3 + A)).Address(0, 0) Else oDic(meAr(0)(A, 1)) = "AH" & 3 + A End If End If Next A meAr(0) = oDic.Keys meAr(1) = oDic.Items For A = Lbound(meAr(0)) To Ubound(meAr(0)) strString = strString & "'" & meAr(0)(A) & "' In Zelle: " & meAr(1)(A) & vbCr Next A MsgBox Left$(strString, Len(strString) - 1) End Sub

Hallo!
Das ganze ist mir etwas zu kompliziert. Hänge deßhalb eine Testdatei an, die erklären soll was ich will.
Wenn in den Spalten S u. T Einträge sind dann handelt es sich um gleiche Positionen.
Wenn das so ist soll in der ersten Position die Stückzahl (K) um die Anzahl der gleichen erhöt werden und der Gesamtpreis (N) neu berechnet werden. Die darunter liegende Zeilen mit der Gleichen Pos. soll dann die Zellinhalte gelöscht werden bis auf die Spalte I und J.
Wenn in der Spalte P ein Eintrag ist (ausgeschieden) dann soll diese Zeile keine Berücksichtigung finden.
https://www.herber.de/bbs/user/67409.xls
Ich hab in der Datei zwei Tabellenblätter drinnen Tabelle1 = Start ; So solls aussehen = Ergebnis
Gruß
Leitz G.

Sub testing() Dim i As Long For i = Sheets(1).UsedRange.Rows.Count To 4 Step -1 If Cells(i, 19).Value "" And IsNumeric(Cells(i, 20)) Then If Cells(i, 19).Value = Cells(i - 1, 19).Value Then Cells(i - 1, 11).Value = Cells(i - 1, 11).Value + Cells(i, 11).Value Cells(i, 11).ClearContents Cells(i, 8).ClearContents Cells(i, 14).ClearContents Cells(i - 1, 14).Value = Cells(i - 1, 8).Value * Cells(i - 1, 11).Value End If End If Next i End Sub

Hallo,
versuch mal:

Sub testing()
Dim i As Long
Dim a As Long
Dim b As Boolean
Dim c As Boolean
For i = Sheets(1).UsedRange.Rows.Count To 4 Step -1
b = False
c = True
If Cells(i, 19).Value  "" And IsNumeric(Cells(i, 20)) And Cells(i, 16) = "" Then
If Cells(i, 19).Value = Cells(i - 1, 19).Value Then
If Cells(i - 1, 16).Value  "" Then b = True
If b Then
a = 1
If Cells(i, 19).Value  Cells(i - 1 - a, 19).Value Then c = False
b = False
Else
a = 0
End If
If c Then Cells(i - 1 - a, 11).Value = Cells(i - 1 - a, 11).Value + Cells(i, 11).Value
If c Then Cells(i, 11).ClearContents
If c Then Cells(i, 8).ClearContents
If c Then Cells(i, 14).ClearContents
If c Then Cells(i - 1 - a, 14).Value = Cells(i - 1 - a, 8).Value * Cells(i - 1 - a, 11).Value
End If
End If
If Cells(i, 16)  "" Then
Cells(i, 11).ClearContents
Cells(i, 8).ClearContents
Cells(i, 14).ClearContents
End If
Next i
End Sub

Gruß
welga

Beliebteste Forumthreads (12 Monate)

11 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread