06.02.2015, 13:28
06.02.2015, 13:59
Hi,
dann ziehst Du dort den Summanden wieder ab.
dann ziehst Du dort den Summanden wieder ab.
06.02.2015, 17:32
Hi,
Das geht leider auch nicht :/
Das geht leider auch nicht :/
06.02.2015, 18:00
Hallo,
ich habe in das Makro eine Zellauswahl eingefügt, von wo aus die Werte eingetragen werden. Es erfolgt hier aber keine Fehlerabfrage, wenn auf Abbrechen geklickt oder keine Zellladresse eingetragen wird!
Nachtrag: Fehlernotbehandlung eingebaut.
ich habe in das Makro eine Zellauswahl eingefügt, von wo aus die Werte eingetragen werden. Es erfolgt hier aber keine Fehlerabfrage, wenn auf Abbrechen geklickt oder keine Zellladresse eingetragen wird!
Code:
Sub prcX2()
Dim rngSuche As Range, rngAusgabe As Range
Dim lngLastRow As Long, lngC As Long
Dim strArt As String, strAdresse As String
Set rngAusgabe = Application.InputBox("Von welcher Zelle aus soll gestartet werden?", "Zellauswahl", Type:=8)
With Worksheets("Tabelle2")
'die Daten aus dem Auswertebereich löschen
On Error Resume Next
rngAusgabe.Resize(rngAusgabe.End(xlDown).Row, 7).ClearContents
On Error Goto 0
' .Cells(2, 7).Resize(.Cells(2, 7).End(xlDown).Row - 1, 6).ClearContents
'Schleife für den Suchwert und -/+ 10
For lngC = -10 To 10
'der Wert wird im Zellbereich E5:N16 gesucht
Set rngSuche = Worksheets("Tabelle1").Range("E5:N16").Find(What:=.Range("B6") + lngC, LookIn:=xlValues, LookAt:=xlWhole)
'wenn es einen Treffer gibt....
If Not rngSuche Is Nothing Then
'...wird die Adresse des ersten Treffers in einer Variablen gespeichert....
strAdresse = rngSuche.Address
Do
If Worksheets("Tabelle1").Cells(4, rngSuche.Column).Value = .Cells(6, 4).Value And _
(.Cells(6, 3).Value = "X" And rngSuche.Column < 10 Or .Cells(6, 3).Value = "Y" And rngSuche.Column > 9) Then
'... und die erste freie Zelle im Auswertebereich gesucht....
If Not IsEmpty(rngAusgabe) Then lngLastRow = .Cells(.Rows.Count, rngAusgabe.Column).End(xlUp).Row + 1 Else lngLastRow = rngAusgabe.Row
' ... und in die Tabelle eingetragen
.Cells(lngLastRow, rngAusgabe.Column).Value = rngSuche.Value
.Cells(lngLastRow, rngAusgabe.Column).Offset(, 1).Value = IIf(rngSuche.Column < 10, "X", "Y")
.Cells(lngLastRow, rngAusgabe.Column).Offset(, 2).Value = Worksheets("Tabelle1").Cells(4, rngSuche.Column).Value
.Cells(lngLastRow, rngAusgabe.Column).Offset(, 3).Value = "Option" & IIf(rngSuche.Row < 11, "1", "2")
Select Case rngSuche.Row
Case 5 To 7, 11 To 13
strArt = "Art1"
Case Else
strArt = "Art2"
End Select
.Cells(lngLastRow, rngAusgabe.Column).Offset(, 4).Value = strArt
' .Cells(lngLastRow, 12).Value = .Cells(rngSuche.Row, 4).Value
'Suche nach einen weiteren Treffer
End If
Set rngSuche = Worksheets("Tabelle1").Range("E5:N16").FindNext(rngSuche)
'und wiederhole es solange, bis der erste Treffer wieder gefunden wird
Loop While rngSuche.Address <> strAdresse
End If
Next lngC
End With
End SubNachtrag: Fehlernotbehandlung eingebaut.
06.02.2015, 18:36
Hi,
"das geht nicht" ist keine hilfreiche Aussage.
Was passiert? Was passiert nicht? Was soll passieren?
(06.02.2015, 17:32)ECM25 schrieb: [ -> ]Das geht leider auch nicht :/
"das geht nicht" ist keine hilfreiche Aussage.
Was passiert? Was passiert nicht? Was soll passieren?
08.02.2015, 18:46
Ich habe entscheiden die Ausgabe ab der 2 Zeile beizubehalten. :)
Danke an alle !
Danke an alle !