RowCount bis zu bestimmten Wert

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Test() Dim koord1 As String Dim koord2 As String Dim koord1a As String Dim koord2a As String Dim koordB As String k = 3 '2 kmax = Worksheets(2).UsedRange.SpecialCells(xlCellTypeLastCell).Row Do Until k > kmax koord1 = Cells(k - 1, 32).Value koord2 = Cells(k, 32).Value If Worksheets(2).Cells(k, 32).Value = "START" Then Cells(k, 34).Value = "0" Else 'welche Matrix If Worksheets(2).Cells(k, 17).Value 32 Then Worksheets("Matrix E2").Select koord1a = WorksheetFunction.Match(koord1, Columns("A"), 0) MsgBox "Zeile " & koord1a koord2a = WorksheetFunction.Match(koord2, Rows(1), 0) koordB = Cells(koord1a, koord2a).Value Worksheets(2).Select Cells(k, 34).Value = koordB Else Worksheets("Matrix E3").Select koord1a = WorksheetFunction.Match(koord1, Columns("A"), 0) MsgBox "Zeile " & koord1a koord2a = WorksheetFunction.Match(koord2, Rows(1), 0) koordB = Cells(koord1a, koord2a).Value Worksheets(2).Select Cells(k, 34).Value = koordB End If 'welche Matrix End If k = k + 1 Loop End Sub

Sub Entfernungenziehen() Dim k As Long Dim kmax As Long Dim ko1 As Variant Dim ko2 As Variant Dim ko1h As Variant Dim ko2h As Variant Dim koord As Variant Worksheets(2).Select k = 2 kmax = Worksheets(2).UsedRange.SpecialCells(xlCellTypeLastCell).Row Do Until k > kmax ko1 = Cells(k - 1, 32).Value ko2 = Cells(k, 32).Value If ko2 = "START" Then Cells(k, 34).Value = "0" Else Worksheets("Matrix E1").Select ko1h = WorksheetFunction.Match(ko1, Columns("A"), 0) ko2h = WorksheetFunction.Match(ko2, Rows("1"), 0) ''''''''''''' Sowohl mit "1" als auch nur 1 _ probiert koord = Cells(ko1h, ko2h).Value Worksheets(2).Select Cells(k, 34).Value = koord End If k = k + 1 Loop End Sub

Hi Daniel,
habe es auf deine Art probiert, jedoch klappt das noch nicht.
Kannst du mal über den Code schauen?

Dim k As Long
Dim kmax As Long
Dim koord1 As String
Dim koord2 As String
Dim koord1a As String
Dim koord2a As String
Dim koordB As String
Cells(1, 34).Value = "Laufweg"
k = 2
kmax = Worksheets(2).UsedRange.SpecialCells(xlCellTypeLastCell).Row
If Worksheets(2).Cells(k, 17).Value < 33 Then
koord1a = Worksheets("Matrix E1").Columns(1).Find(what:=koord1, lookat:=xlWhole, LookIn:=xlValue).Row
koord2a = Worksheets("Matrix E1").Row(1).Find(what:=koord2, lookat:=xlWhole, LookIn:=xlValue).Column
koordB = Worksheets("Matrix E1").Cells(koord1a, koord2a).Value
Cells(k, 34).Value = koordB
ElseIf Worksheets(2).Cells(k, 17).Value < 65 And Worksheets(2).Cells(k, 17).Value > 32 Then
koord1a = Worksheets("Matrix E2").Columns(1).Find(what:=koord1, lookat:=xlWhole, LookIn:=xlValue).Row
koord2a = Worksheets("Matrix E2").Row(1).Find(what:=koord2, lookat:=xlWhole, LookIn:=xlValue).Column
koordB = Worksheets("Matrix E2").Cells(koord1a, koord2a).Value
Cells(k, 34).Value = koordB
Else
koord1a = Worksheets("Matrix E3").Columns(1).Find(what:=koord1, lookat:=xlWhole, LookIn:=xlValue).Row
koord2a = Worksheets("Matrix E3").Row(1).Find(what:=koord2, lookat:=xlWhole, LookIn:=xlValue).Column
koordB = Worksheets("Matrix E3").Cells(koord1a, koord2a).Value
Cells(k, 34).Value = koordB
End If
End If
k = k + 1
Loop

und kannst du mal erläutern, was du da machst und wo genau das Problem steckt?
auf den ersten Blick fällt auf, dass
1. du die Variablen mit den Suchbegriffen (korrd1, koord2) nicht befüllst.
2. das Rangeobjekt mit den Zeilen "Rows" heißt und nicht "Row" (analog zu "Columns")
3. du die ermittelten Zeilen- und Spaltennummern in Textstrings schreibst obwohl es Zahlen sind
damit funktionert das Cells dann nicht mehr, denn wenn der Wert für die Spalte (2. Parameter) ein Text ist, erwartet Cells den Spaltenbuchstaben und nicht die Spaltennummer.
(bei der Zeile kann man das machen, weil eine Zeile immer als Zahl angegeben werden muss, daher kann VBA versuchen, einen Text in eine Zahl zuwandeln, bei der Spalte kann man jedoch Text (Spaltenbuchstaben) oder Zahl (Spaltennummer) verwenden, daher ist eine Umwandlung von Text in Zahl nicht möglich und es muss der Fehler ausgeben werden, dass es eine Spalte mit dem Spaltenbuchstaben "1" nicht gibt.
Gruß Daniel

k = 2 kmax = Worksheets(2).UsedRange.SpecialCells(xlCellTypeLastCell).Row Do Until k > kmax koord1 = Cells(k - 1, 32).Value koord2 = Cells(k, 32).Value If Worksheets(2).Cells(k, 32).Value = "START" Then Cells(k, 34).Value = "0" Else If Worksheets(2).Cells(k, 17).Value

Beliebteste Forumthreads (12 Monate)

13 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

13
Beiträge zum Forumthread

Beiträge zu diesem Forumthread