Microsoft Excel

Herbers Excel/VBA-Archiv

Wo ist der Fehler? Bitte um Hilfe

Betrifft: Wo ist der Fehler? Bitte um Hilfe von: Willi Wacker
Geschrieben am: 27.11.2015 12:15:30

Hallo Leute,

nachdem ich jetzt so lange gesucht habe, muß ich aufgeben und hoffe einer von Euch findet den Fehler.

Kurz zum Ablauf: in einer Tabelle wird per Zufallsprinzip in Spalte D eine Zeile ausgewählt. Wenn in Spalte P nicht Panasonic steht und in Spalte D nicht Zubehör, dann sollen die weiteren Befehle ausgeführt werden. NUR! zum einen erhalte ich hin und wieder gar keinen Inhalt (habe ich einfach mal abgefangen durch die Abfrage nach "") in der Variablen Zubehoer und damit auch nicht in Zubehoer1 und manchmal wird die Zeile, obwohl Zubehör in der Zelle steht, kopiert. Warum???


Sub AAZufallsfeld()

    Dim ZZahl As Integer, ZZahl1 As Integer, ZZahl2 As Integer, lngZielZeile As Integer, b As   _
_
Integer, x As Integer
    Dim i As String
    Dim x1 As Long
    Dim wksS As Worksheet, wksC As Worksheet
    Dim Zubehoer As String, Zubehoer1 As String
    Dim DateHeute As Date
            
    Set wksC = Worksheets("CSV-Datei")
    Set wksS = Worksheets("Sonderangebote")
    
    x1 = Sheets("CSV-Datei").UsedRange.SpecialCells(xlCellTypeLastCell).Row
    b = 2
    DateHeute = Date
    
    Randomize

    For x = 1 To x1

        Sheets("CSV-Datei").Select
        
        ZZahl1 = Int((x1 * Rnd) + 1)            
        ZZahl2 = ZZahl1 + 2                     
        Zubehoer = wksC.Range("D" & ZZahl2)
        Zubehoer1 = Left(Zubehoer, 7)
        
        If wksC.Cells(ZZahl2, 16) <> "Panasonic" Then
            If Zubehoer1 <> "Zubehör" And Zubehoer <> "" Then
                If wksC.Cells(ZZahl2, 57) <> "X" Then
                    wksC.Rows(ZZahl2).Copy Destination:=wksS.Range("A" & b)
                    Sheets("Sonderangebote").Select
                    wksS.Cells(b, 11) = DateHeute
                    wksS.Cells(b, 12) = DateHeute + 7
                    wksS.Cells(b, 5).Select
                    ActiveCell.FormulaR1C1 = _
                           "=IF(RC[61]<=RC[2],RC[2]+(RC[2]*6/100),RC[61])"
                    wksS.Cells(b, 58) = "X"

                    If b = 13 Then
                        GoTo 12
                    End If
                                    
                    wksS.Rows(b).Copy Destination:=wksC.Range("A" & ZZahl2)
                    b = b + 1
                End If
            End If
        End If
       
    Next x
    
12:

    Sheets("Sonderangebote").Select

End Sub


Ich bin für jede Hilfe dankbar, aber bitte verwirrt mich nicht mit einer ganz neuen Programmierung. Bin ja schon froh so weit gekommen zu sein. Danke.

Willi

  

Betrifft: AW: Wo ist der Fehler? Bitte um Hilfe von: Rudi Maintaire
Geschrieben am: 27.11.2015 12:32:27

Hallo,
wenn in der Zelle z.B. " Zubehör blabla" steht, wird zubehoer1 zu " Zubehö" und ist damit <> "Zubehör" und <>"".

Versuchs mal mit
Zubehoer = Trim(wksC.Range("D" & ZZahl2))

Gruß
Rudi


  

Betrifft: AW: Wo ist der Fehler? Bitte um Hilfe von: Willi Wacker
Geschrieben am: 27.11.2015 13:23:28

Hallo Rudi,

ich hab's jetzt x mal durchlaufen lassen. Das war's Super es funzt.

Danke dafür

Willi


 

Beiträge aus den Excel-Beispielen zum Thema "Wo ist der Fehler? Bitte um Hilfe"