Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1408to1412
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Zeilen durchlaufen und Bereich prüfen

Zeilen durchlaufen und Bereich prüfen
24.02.2015 07:50:59
Rectranthus
Hallo zusammen
Ich bin im Moment an einem umfangreichen Makro und brauche bei einer Schleife eure Hilfe. :)
Ich habe eine Tabelle, bei der ich jede Zeile abarbeiten möchte. Die Schleife dazu habe ich angepasst, dass würde auch funktionieren.
Nun kommt die Schwierigkeit:
In der Spalte C;H habe ich entweder in einer Zelle einen Wert oder in mehr als einer Zelle einen Wert.
Nun soll geprüft werden, ob nur dieser eine Wert vorhanden ist oder mehrere Werte.
Wenn nur ein Wert vorhanden ist, soll dieser in die Spalte M geschrieben werden, bei mehr als einem Wert soll ein Fehler ausgegeben werden.
Vorlage für die Schleife:
Sub Test()
Dim i As Integer
i = 1
Do While Not Cells(i, 1) = ""
If Cells(i, 1) > 5 Then Cells(i, 2) = 10
i = i + 1
Loop
End Sub

Als Beispiel habe ich noch eine kleine Datei angehängt. Hoffe es ist einigermassen verständlich.
Vielen Dank für eure Tipps.
Grüsse
JP

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW:Bsp.-Mappe fehlt gruss owT
24.02.2015 07:54:53
hary
.

AW: mit Formel!?
24.02.2015 08:57:50
hary
Moin
Das kannst du auch mit Formel machen. Wenn es dir so reicht.



TEST
 M
21.25
31.38
412.50
5Fehler
6Fehler
736.00
838.00
934.00
1036.00
113.83
124.37
134.25
143.30

verwendete Formeln
Zelle Formel Bereich R1C1 für Add In
M2:M14=WENN(ANZAHL2(C2:H2)=1;VERWEIS(2;1/(C2:H2<>"");C2:H2);"Fehler")  =IF(COUNTA(RC[-10]:RC[-5])=1,LOOKUP(2,1/(RC[-10]:RC[-5]<>""),RC[-10]:RC[-5]),"Fehler")

http://excel-inn.de/dateien/vba_beispiele/tabellenanzeige_in_html_addin.zip
http://hajo-excel.de/tools.htm
XHTML-Tabelle zur Darstellung in Foren, einschl. der neuen Funktionen ab Version 2007
Add-In-Version 14.02 einschl 64 Bit

gruss hary

Anzeige
AW: AW:Gelöst
25.02.2015 14:38:44
JP
Hallo Hary
Vielen Dank für deinen Tip. Es hat wunderbar geklappt, die komplette Schleife ist nun so aufgebaut:
Sub Ausschnitt()
' Schleife um die Werte zusammenzufassen und für den Druck vorbereiten
iRow = 5 ' Start ab Zeile 5
Do While Not IsEmpty(Cells(iRow, 1)) ' Schleife in Spalte A bis zur ersten leeren Zelle  _
durchführen
Cells(iRow, 10).FormulaR1C1 = "=IF(COUNTA(RC11:RC16)=1,LOOKUP(2,1/(RC11:RC16""""), _
RC11:RC16),""Fehler"")"
iRow = iRow + 1
Loop
' Die Formel in Spalte J in Werte umwandeln
With wb.Worksheets("Test")
.Columns("J:J").Copy
.Columns("J:J").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
End With
' Vorhandene Fehler zählen
intFehler = WorksheetFunction.CountIf(Range("J:J"), "Fehler") ' Fehler in Variable übergeben
Debug.Print intFehler
'Meldung für die Fehler nur ausgeben, falls Fehler  0
If intFehler  0 Then
' Schleife um Fehler zu markieren
iRow = 5 ' Start ab Zeile 5
Do While Not IsEmpty(Cells(iRow, 1)) ' Schleife in Spalte A bis zur ersten leeren Zelle  _
durchführen
If Cells(iRow, 10) = "Fehler" Then
Cells(iRow, 10).Interior.ColorIndex = 3
End If
iRow = iRow + 1
Loop
'Meldun ausgeben
MsgBox "ACHTUNG: Konditionen können nicht exportiert werden - Abbruch" & vbLf & _
intFehler & " Fehler gefunden" & vbLf & vbLf & _
"Bitte wenden Sie sich an den Administrator", vbCritical, "Fehler"
Exit 

Sub ' Anwendung abbrechen, Fehler müssen korrigiert werden
End If
End Sub
Grüsse
JP

Anzeige
AW: AW:Gelöst
25.02.2015 15:48:36
hary
Moin
Wie ich sehe kannst du ja VBA.
Geht auch ohne Schleifen und Filter. Den Code kannst du dir ja anpassen.
Dim letzte As Long
On Error GoTo allesgut
With Worksheets("Test")
'--letzte belegte Zeile nach SpalteA
letzte = .Cells(.Rows.Count, 1).End(xlUp).Row
'--Formel in einem Rutsch
.Range("J2:J" & letzte).FormulaR1C1 = "=IF(COUNTA(RC11:RC16)=1,LOOKUP(2,1/(RC11:RC16""""), _
RC11:RC16),""Fehler"")"
'--- Formel in Wert
.Range("J2:J" & letzte).Value = .Range("J2:J" & letzte).Value
'---autofilter setzen und filtern nach Fehler
.Range("J1").AutoFilter field:=1, Criteria1:="Fehler"
'----faerben
.Range("J2:J" & letzte).SpecialCells(xlVisible).Interior.ColorIndex = 3
'--- Filter abschalten
MsgBox "Es gibt Fehler"
allesgut:
.Range("J1").AutoFilter
End With

gruss hary
Anzeige

9 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige