Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
696to700
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
696to700
696to700
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Abfrage ausführen vor Makro Rest

Abfrage ausführen vor Makro Rest
20.11.2005 17:12:57
Klaus
Hallo Excel und Makro Spezis,
Im nachfolgenden Makro würde ich gerne eine Abfrage durchführen,
bevor das eigentliche Makro(Rest) ausgeführt wird.
Prüfen ob im Bereich H6 bis H46 im akt.Sheet irgendwo ein x steht
wenn nein dann Meldung und abbrechen
wenn ja dann weiter mit Makro.
Habe schon mal angefangen, aber komme hier nicht weiter.
Könnt ihr hier helfen?

Private Sub CommandButton2_Click()
Dim rng As Range
Dim rng2 As Range
Dim lngE As Long
Dim wann
'prüfen ob im Bereich H6 bis H46 irgendwo ein x steht
'evtl noch Meldung wenn mehr als ein x
'wenn ja dann weiter mit makro, wenn kein x abbrechen
Set rng2 = Sheets("Einzahlungen").Range("H6:H46")
If  then
MsgBox "Es wurde noch keine Zsatzzahl eingegeben!"
End If
Exit Sub
'x vorhanden weiter
wann = Sheets("Einzahlungen").Range("B5").Value
Set rng = Sheets("Einzahlungen").Range("A6:J47")
With Sheets("Jahresbeträge")
lngE = .Range("A65536").End(xlUp).Row + 1
rng.Copy
.Cells(lngE, 1).PasteSpecial Paste:=xlPasteValues
.Cells(lngE, 1).PasteSpecial Paste:=xlPasteFormats
End With
Range("D6:D45, E6:E45,H6:H45 ").Select
Selection.ClearContents
Range("A5").Select
gesamt
Summe2
Range("A5").Value = Range("A5").Value + 7
Sheets("Übersicht Summen").Range("C3").Value = Now & "- mit KW:" & wann
Sheets("Einzahlungen").Activate
End Sub

Gruss
Klaus

9
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Abfrage ausführen vor Makro Rest
20.11.2005 17:16:44
Peter
Hallo Klaus,
sieh dir mal den Eintrag "Wert mit Tabellevergleichen von Unbekannter Nummer Eins am 20.11.2005 00:21:44" etwas tiefer hier an. Das könnte deine Lösung sein.
Viele Grüße Peter
Eine kurze Nachricht, ob es läuft, wäre nett - danke.
AW: Abfrage ausführen vor Makro Rest
20.11.2005 17:28:03
Klaus
Hallo Peter,
hab ich gefunden und mal reinge"baut".....
die Abfrage funktioniert, aber es kommt 40 mal die MSGBox, also für jede Zelle in der kein x steht. Kann man das nicht anders abfragen ?

Private Sub CommandButton2_Click()
Dim rng As Range
Dim rng2 As Range
Dim lngE As Long
Dim cells As Range
Dim wann
'prüfen ob im Bereich H6 bis H46 irgendwo ein x steht
'evtl noch Meldung wenn mehr als ein x
'wenn ja dann weiter mit makro, wenn kein x abbrechen
Set rng2 = Sheets("Einzahlungen").Range("H6:H46")
For Each cells In rng2
If Not cells.Value = "x" Then
MsgBox "Es wurde noch keine Zusatzzahl eingegeben!"
End If
Next
Exit Sub
'x vorhanden weiter
wann = Sheets("Einzahlungen").Range("B5").Value
Set rng = Sheets("Einzahlungen").Range("A6:J47")
With Sheets("Jahresbeträge")
lngE = .Range("A65536").End(xlUp).Row + 1
rng.Copy
.cells(lngE, 1).PasteSpecial Paste:=xlPasteValues
.cells(lngE, 1).PasteSpecial Paste:=xlPasteFormats
End With
Range("D6:D45, E6:E45,H6:H45 ").Select
Selection.ClearContents
Range("A5").Select
gesamt
Summe2
Range("A5").Value = Range("A5").Value + 7
Sheets("Übersicht Summen").Range("C3").Value = Now & "- mit KW:" & wann
Sheets("Einzahlungen").Activate
End Sub

gruss
Klaus
Anzeige
AW: Abfrage ausführen vor Makro Rest
20.11.2005 17:41:34
Peter
Hallo Klaus,
ich hatte das kleine Makro

Sub finden()
Dim a, b, c As Integer
For a = 3 To 8
For b = 13 To 16
If Cells(b, a).Value = Range("e19") Then c = c + 1
Next b
Next a
If c > 0 Then MsgBox "ist " & c & " mal da"
End Sub

gemeint. Versuch das doch mal.
Viele Grüße Peter
Eine kurze Nachricht, ob es läuft, wäre nett - danke.
AW: Abfrage ausführen vor Makro Rest
20.11.2005 18:01:05
Klaus
Hallo Peter,
jetzt sieht mein Code so aus
(haut aber auch nicht hin, ich glaub ich verstricke mich hier immmer mehr)
Laufzeitfehler 91 in If cells(b, 8).Value = "x" Then c = c + 1

Private Sub CommandButton2_Click()
Dim rng As Range
Dim rng2 As Range
Dim lngE As Long
Dim cells As Range
Dim wann
Dim b, c As Integer
'prüfen ob im Bereich H6 bis H46 irgendwo ein x steht
'evtl noch Meldung wenn mehr als ein x
'wenn ja dann weiter mit makro, wenn kein x abbrechen
Set rng2 = Sheets("Einzahlungen").Range("H6:H46")
For b = 6 To 46 'Zeile
If cells(b, 8).Value = "x" Then c = c + 1
Next b
If c > 1 Or c < 1 Then MsgBox "Fehler, Daten wurden nicht übertragen"
If c = 1 Then
'x vorhanden weiter
wann = Sheets("Einzahlungen").Range("B5").Value
Set rng = Sheets("Einzahlungen").Range("A6:J47")
With Sheets("Jahresbeträge")
lngE = .Range("A65536").End(xlUp).Row + 1
rng.Copy
.cells(lngE, 1).PasteSpecial Paste:=xlPasteValues
.cells(lngE, 1).PasteSpecial Paste:=xlPasteFormats
End With
End If
Range("D6:D45, E6:E45,H6:H45 ").Select
Selection.ClearContents
Range("A5").Select
gesamt
Summe2
Range("A5").Value = Range("A5").Value + 7
Sheets("Übersicht Summen").Range("C3").Value = Now & "- mit KW:" & wann
Sheets("Einzahlungen").Activate
Range("K14").Value = "zuletzt erfasst : KW-" & Range("B5").Value
End Sub

Anzeige
AW: Abfrage ausführen vor Makro Rest
20.11.2005 17:51:15
PeterW
Hallo Klaus,
wenn es nur darum geht zu prüfen, ob überhaupt ein "x" im Bereich steht dann vielleicht so:

Sub Zaehlenwenn()
If WorksheetFunction.CountIf(Range("H6:H46"), "x") > 0 Then
MsgBox "mindestens 1 x vorhanden"
Else
MsgBox "kein x im Bereich"
End If
End Sub

Gruß
Peter
AW: Abfrage ausführen vor Makro Rest
20.11.2005 18:09:43
Klaus
Hallo Peter,
mit dem rekorder hab ich das zählenwenn auch schon aufgezeichnet,
nachdem ich aber den Code
ActiveCell.FormulaR1C1 = "=COUNTIF(R[-8]C[-3]:R[32]C[-3],x)"
gesehen habe, ist mir ....übel geworden
soll heissen - da hab ich dann den Durchblick nicht gehabt.
schönen Dank
Gruss
Heribert
Anzeige
AW: Abfrage ausführen vor Makro Rest
20.11.2005 17:59:21
Eule
Hi Klaus
probier dies:

Private Sub CommandButton1_Click()
Dim rng As Range
Dim rng2 As Range
Dim lngE As Long
Dim cells As Range
Dim wann
'prüfen ob im Bereich H6 bis H46 irgendwo ein x steht
'evtl noch Meldung wenn mehr als ein x
'wenn ja dann weiter mit makro, wenn kein x abbrechen
Set rng2 = Sheets("Einzahlungen").Range("H6:H46")
Dim z As Integer
For Each cells In rng2
If cells.Value = "x" Then
z = z + 1
Else
End If
Next
If z = 0 Then
MsgBox "Es wurde noch keine Zusatzzahl eingegeben!"
Exit Sub
Else
MsgBox "Es wurde " & z & " mal die Zusatzzahl eingegeben!"
'x vorhanden weiter
wann = Sheets("Einzahlungen").Range("B5").Value
Set rng = Sheets("Einzahlungen").Range("A6:J47")
With Sheets("Jahresbeträge")
lngE = .Range("A65536").End(xlUp).Row + 1
rng.Copy
.cells(lngE, 1).PasteSpecial Paste:=xlPasteValues
.cells(lngE, 1).PasteSpecial Paste:=xlPasteFormats
End With
Range("D6:D45, E6:E45,H6:H45 ").Select
Selection.ClearContents
Range("A5").Select
gesamt
Summe2
Range("A5").Value = Range("A5").Value + 7
Sheets("Übersicht Summen").Range("C3").Value = Now & "- mit KW:" & wann
Sheets("Einzahlungen").Activate
End If
End Sub

Gruss Eule
Anzeige
AW: Abfrage ausführen vor Makro Rest
20.11.2005 18:05:52
Klaus
Hallo Eule, Peter,
ich war der Lösung doch ziemlich nah(Tips von Peter),
dank Eule für den letzten Schliff.
Ich bedanke mich bei euch beiden herzlich.....
Gruss
Klaus
Danke für die Rückmeldung owT
20.11.2005 18:12:36
Eule

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige