Guten Tag,
ich würde gern per VBA prüfen lassen ob die Zahl oder auch der Text, von der Zelle A2,
in Spalte A, vorhanden ist.
Anbei die Musterdatei: https://www.herber.de/bbs/user/159846.xlsm
mfg siegfried b
Guten Tag,
ich würde gern per VBA prüfen lassen ob die Zahl oder auch der Text, von der Zelle A2,
in Spalte A, vorhanden ist.
Anbei die Musterdatei: https://www.herber.de/bbs/user/159846.xlsm
mfg siegfried b
Sub Unit()
Dim lngCt As Long
If Not IsEmpty(Range("A2")) Then
lngCt = WorksheetFunction.CountIf(Range("A4:A" & Rows.Count), Range("A2"))
End If
MsgBox lngCt & " mal"
End Sub
Gruß Gerd
Dim wksQUELLE As Worksheet 'Quell-Worksheet
Dim wksZIEL As Worksheet 'Ziel-Worksheet
Dim wkbZIEL As Workbook, wkbQUELLE As Workbook
Dim rngZIEL As Range
Set wkbQUELLE = ActiveWorkbook
Set wksQUELLE = ActiveSheet
Dim lngCt As Long
'If Not IsEmpty(Range("A2")) Then
If Not IsEmpty(wksQUELLE.Range("K11")) Then 'meine offene Datei und der aktiven Sheet in K11 steht immer die Nummer / Text drin
' lngCt = WorksheetFunction.CountIf(Range("A3:A" & Rows.Count), Range("A2")) 'aus deinem Makro
lngCt = wkbZIEL.WorksheetFunction.CountIf(Range("A3:A" & Rows.Count).wksQUELLE.Range("K11").Value) 'die Ziel Datei wird schon vorher geöffnet
MsgBox "Kundennummer schon vorhanden"
wkbZIEL.Close True
Exit Sub
Else
MsgBox "Nummer fehlt"
MsgBox "Daten werden jetzt übertragen"
'...
habe mir das alles mal zusammengesucht und hoffte das es klappt,
lngCt = WorksheetFunction.CountIf(Workbooks("DateiderErmittlung.xlsx oder .xlsm").Worksheets("BlattderErmittlung").Range("A3:A" & Rows.Count), wksQUELLE.Range("K11").Value)
Hallo Siegfried,
Dim wksQUELLE As Worksheet 'Quell-Worksheet
Dim wksZIEL As Worksheet 'Ziel-Worksheet
Dim wkbZIEL As Workbook, wkbQUELLE As Workbook
Dim rngZIEL As Range
Dim strSUCH As String
Const cstr_wkbQUELLE As String = "Werkstatt.xlsm"
Const cstr_wksQUELLE As String = "Daten"
Set wkbQUELLE = ActiveWorkbook
Set wksQUELLE = ActiveSheet
On Error Resume Next
Set wkbZIEL = Workbooks(cstr_wkbQUELLE)
On Error GoTo 0
If wkbZIEL Is Nothing Then
Set wkbZIEL = Workbooks.Open("D:\" & cstr_wkbQUELLE)
End If
'Worksheet-Variable setzen
Set wksZIEL = wkbZIEL.Worksheets(cstr_wksQUELLE)
mfg siegfried b
lngCt = WorksheetFunction.CountIf(Workbooks(wksQuelle.Range("A3:A" & wksQuelle.UsedRange.Rows.Count), wksQUELLE.Range("K11").Value)
wenn über die gesamte Spalte gesucht werden soll/muss
lngCt = WorksheetFunction.CountIf(Workbooks(wksQuelle.Range("A3:A" & wksQuelle.Rows.Count), wksQUELLE.Range("K11").Value)
hth
Dim lngCt As Long
If Not IsEmpty(wksQUELLE.Range("K11")) Then 'meine offene Datei und der aktiven Sheet in K11 steht immer die Nummer / Text drin
lngCt = WorksheetFunction.CountIf(wksQUELLE.Range("A3:A" & wksQUELLE.Rows.Count), wksQUELLE.Range("K11").Value)
MsgBox "Kundennummer schon vorhanden"
wkbZIEL.Close True
Exit Sub
Else
MsgBox "Nummer fehlt"
MsgBox "Daten werden jetzt übertragen"
mfg siegfried b
Dim lngCt As Long
If Not IsEmpty(wksQUELLE.Range("K11")) Then 'meine offene Datei und der aktiven Sheet in K11 steht immer die Nummer / Text drin
lngCt = WorksheetFunction.CountIf(wksQUELLE.Range("A3:A" & wksQUELLE.Rows.Count), wksQUELLE.Range("K11").Value)
End If
If lngCt > 0 Then
MsgBox "Kundennummer schon vorhanden"
wkbZIEL.Close True
Exit Sub
End If
Else
MsgBox "Nummer fehlt"
MsgBox "Daten werden jetzt übertragen"
End If
Gruß Gerd
Dim lngCt As Long
If Not IsEmpty(Range("K11")) Then
lngCt = WorksheetFunction.CountIf(wksZIEL.Range("A3:A" & Rows.Count), wksQUELLE.Range("K11").Value)
' MsgBox lngCt
If lngCt = 1 Then '1 vorhanden 0= Nummer fehlt
MsgBox "Kundennummer schon vorhanden"
wkbZIEL.Close True
Exit Sub
Else
MsgBox "Nummer fehlt"
End If
MsgBox "jetzt wird kopiert"
'...
Es läuft ohne Fehler durch, habe mit ' MsgBox lngCt und in der Zieldatei geprüft.
Dim wksQUELLE As Worksheet 'Quell-Worksheet
Dim wksZIEL As Worksheet 'Ziel-Worksheet
Dim wkbZIEL As Workbook, wkbQUELLE As Workbook
Dim rngZIEL As Range
Dim strSUCH As String
Const cstr_wkbQUELLE As String = "Werkstatt.xlsm"
Const cstr_wksQUELLE As String = "Daten"
Set wkbQUELLE = ActiveWorkbook
Set wksQUELLE = ActiveSheet
On Error Resume Next
Set wkbZIEL = Workbooks(cstr_wkbQUELLE)
On Error GoTo 0
If wkbZIEL Is Nothing Then
Set wkbZIEL = Workbooks.Open("D:\" & cstr_wkbQUELLE)
End If
'Worksheet-Variable setzen
Set wksZIEL = wkbZIEL.Worksheets(cstr_wksQUELLE)
Dim lFile
Dim lloRow As Long, ldtRgDate As Date, lstrRgNr As String, lboOK As Boolean, lloRNext As Long
Dim wks, shs, pshDB
' Application.EnableEvents = False
Application.ScreenUpdating = False
wkbZIEL.Activate
wkbQUELLE.Activate
Dim lngCt As Long
If Not IsEmpty(wksQUELLE.Range("K11")) Then 'meine offene Datei und der aktiven Sheet in K11 steht immer die Nummer / Text drin
lngCt = WorksheetFunction.CountIf(wksQUELLE.Range("A3:A" & wksQUELLE.Rows.Count), wksQUELLE.Range("K11").Value)
End If
If lngCt > 0 Then
MsgBox "Kundennummer schon vorhanden"
wkbZIEL.Close True
Exit Sub
End If
Else
MsgBox "Nummer fehlt"
MsgBox "Daten werden jetzt übertragen"
End If
End If
' wenn fehlt soll es weiter gehen, mit kopieren
wksQUELLE.Range("K11:K22").Copy
rngZIEL.Offset(0, 0).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
mfg siegfried b