Microsoft Excel

Herbers Excel/VBA-Archiv

weitere Bedingung für Übertrag

Betrifft: weitere Bedingung für Übertrag von: Lorenz
Geschrieben am: 12.09.2004 17:31:21

Hallo zusammen!

lt untenstehenden CODE funktioniert alles, ausser:
die auskommentierten Bedingungen bringe ich nicht hin.
Ich probiere nun schon den zweiten Tag herum aber es will und will nicht!
vielleicht lässt sich der Code auch noch "verbessern"
hier der Code:


Sub Eintrag()
Dim iBlatt, iR, iC, iRz, iCz, iSt, iSheet, iBeg, iEnd, iF2, iF6, iF7 As Integer
'Dim iBlatt, iR, iC,(QuellTabelle) iRz, iCz,(ZielTabelle) iSt, iSheet, iBeg, iEnd, iF2, iF6, iF7 As Integer
iStrecke = 2
Set iSheet = Sheets("Blatt" & iBlatt)
With iSheet
.Range("a5:u24").ClearContents
.Cells(1, 9).Value = ActiveSheet.Cells(5, 3) + ActiveCell.Text - 1
End With
iBeg = 6
iEnd = 83
iRz = 5
iCz = 2
iC = 3
iSt = ActiveCell.Column + 1
iF2 = 15
iF6 = 34
iF7 = 36
For iR = iBeg To iEnd
    If Cells(iR, iSt - 1) = "K" Or Cells(iR, iSt - 1) = "U" Then GoTo WeiterMo
    If Cells(iR, iSt) <> "" And Cells(iR, iSt).Interior.ColorIndex = iF2 _
    Or Cells(iR, iSt - 1) <> "" And Cells(iR, iSt - 1).Interior.ColorIndex = iF2 Then
        With iSheet
        .Cells(iRz, iCz) = Cells(iR, iC)
        .Cells(iRz, iCz - 1) = Cells(iR, iSt - 1)
        End With
        iRz = iRz + 1
WeiterMo:   If Cells(iR, iSt) > "" And Cells(iR, iSt).Interior.ColorIndex = iF2 Then
            iSheet.Cells(iRz - 1, iCz + 1) = Cells(iR, iSt)
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
'Das ist der Bereich den ich nicht schaffe:

               'If Cells(iR, iSt) > "" And Cells(iR, iSt).Interior.ColorIndex = iF6 Then
               '         iSheet.Cells(iRz - 1, iCz + 1) = "6"
               'ElseIf Cells(iR, iSt) > "" And Cells(iR, iSt).Interior.ColorIndex = iF7 Then
               '         iSheet.Cells(iRz - 1, iCz + 1) = "7"

'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
                If Cells(iR, iSt) = "o" And Cells(iR, iSt).Interior.ColorIndex = iF2 Then
                iSheet.Cells(iRz - 1, iCz + 1) = "V6"
                    ElseIf Cells(iR, iSt) = "O" And Cells(iR, iSt).Interior.ColorIndex = iF2 Then
                    iSheet.Cells(iRz - 1, iCz + 1) = "V8"
                        Else: iSheet.Cells(iRz - 1, iCz + 1) = Cells(iR, iSt)
    End If
    End If
    End If
    Next

.....
.....
End Sub



Grüsse Lorenz
  


Betrifft: AW: weitere Bedingung für Übertrag von: Hans W. Herber
Geschrieben am: 14.09.2004 08:17:17

Hallo Lorenz,

vom Code her gibt es keinen Grund, warum es nicht funktionieren sollte (wenn die Variablen gültige Werte beinhalten).

Gehe zuerst hin und deklariere die Variablen sauber.

Deine Deklaration:
Dim iBlatt, iR, iC, iRz, iCz, iSt, iSheet, iBeg, iEnd, iF2, iF6, iF7 As Integer

deklariert iF7 als Integer, alles andere als Variant. Deklariere explizit jede einzelne Variable.

Prüfe beim Makrodurchlauf im Schrittmodus, welche Werte die Variablen im kritischen Bereich aufweisen.

Gruss hans


  


Betrifft: AW: weitere Bedingung für Übertrag von: Lorenz
Geschrieben am: 15.09.2004 16:21:42

Hallo Hans!

Hab`s inzwischen den "Übertrag" anders gelöst!
Natürlich werden die Tipps 1:1 im Zuge "learning by doing" von mir eingesetzt.

Deine Vermutung (die ungültigen Werte (der Variablen)) war richtig
Nach der "sauberen" Deklaration lief es Codemässig obendrein noch scheinbar "besser & schneller"!

vielen Dank für die Mühe!

Gruss Lorenz


 

Beiträge aus den Excel-Beispielen zum Thema "weitere Bedingung für Übertrag"