Wert suchen

Forumthread: Wert suchen

Wert suchen

09.08.2005 14:05:31

Alexej

Hallo allerseits,
Komme leider nicht mehr weiter. Habe eine Datei, die zwei weitere Dateien oeffnet (EP und MP). Nun soll nach Werten, die in der EP Datei sind, in der Datei MP gesucht werden. Wenn etwas passendes gefunden wurde, soll halt in der Datei EP, in der Zeile, woher der Wert stammte, die Zeilennummer, wo der Wert gefunden wurde, aus der MP Datei reingeschrieben werden.
Bisjetzt sieht es bei mir so aus, leider springt bei mir bei der Suchfunktion eine Fehlermeldung raus :(
Public


Sub Process()
Dim cTmp As String
Dim sh_ As Worksheet
Dim sh_name As String
Dim selector_ As Integer
Dim no_of_records As Integer
Dim i As Integer
Dim numb As Integer
Dim dumb As String
Dim c As String
Application.EnableEvents = False
Application.ScreenUpdating = False
Application.EnableCancelKey = True
Set EP = Workbooks.Open(ThisWorkbook.Sheets("Files").Range("epname").Value)
Set MP = Workbooks.Open(ThisWorkbook.Sheets("Files").Range("mpname").Value)
For Each sh_ In MP.Worksheets
sh_.Visible = xlSheetVisible
Next
numb = EP.Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To numb
dumb = EP.Worksheets(1).Cells(i, 1).Value
'Hier weiss ich nicht mehr weiter...
With MP
Set c = .Cells.Find(What:=dumb, LookIn:=xlFormulas, LookAt:=xlWhole)
End With
Next i
End Sub

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread

Betreff

Datum

Anwender

Loesung

09.08.2005 15:53:17

Alexej

Loesung

09.08.2005 15:53:17

Alexej

Public


Sub Process()
Application.EnableEvents = False
Application.ScreenUpdating = False
Application.EnableCancelKey = True
Application.Calculation = xlCalculationManual
Dim cTmp As String
err_ = False
Set EP = Workbooks.Open(ThisWorkbook.Sheets("Files").Range("epname").Value)
Set MP = Workbooks.Open(ThisWorkbook.Sheets("Files").Range("mpname").Value)
nstr = 0
CheckMP
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.StatusBar = ""
MP.Close SaveChanges:=False
If Not err_ Then
cTmp = CStr(ThisWorkbook.Sheets("Files").Range("resultpath"))
If Len(cTmp) > 0 And Right(cTmp, 1) <> "\" Then cTmp = cTmp + "\"
Application.DefaultFilePath = cTmp
EP.SaveAs Filename:=cTmp + "Checked " + EP.Name
EP.Close SaveChanges:=False
End If
If err_ Then
MsgBox "Áûëà îøèáêà. Ïðîâåðåíà òîëüêî ÷àñòü ëèñòîâ. Ôàéë íå ñîõðàíåí.", vbCritical + vbOKOnly
Else
MsgBox "Ãîòîâî", vbOKOnly + vbInformation
End If
End Sub


Sub CheckMP()
Dim sh_ As Worksheet
Dim sh_name As String
Dim selector_ As Integer
Dim no_of_records As Integer
Dim i As Integer
Dim numb As Integer
Dim dumb As String
Dim cumb As Object
Dim first As String
'If Not no_error Then Exit Sub
For Each sh_ In MP.Worksheets
sh_.Visible = xlSheetVisible
Next
numb = EP.Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To numb
dumb = EP.Worksheets(1).Cells(i, 1).Value
For Each sh_ In MP.Worksheets
Set cumb = sh_.Cells.Find(What:=dumb, LookIn:=xlFormulas, LookAt:=xlPart)
If Not cumb Is Nothing Then
first = cumb.Address
Do
If Trim(EP.Worksheets(1).Cells(i, 1).Offset(0, 2).Value) = Trim(cumb.Offset(0, 5).Value) Then
EP.Worksheets(1).Cells(i, 1).Offset(0, 6).Value = Trim(cumb.Offset(0, -1).Value)
EP.Worksheets(1).Cells(i, 1).Offset(0, 7).Value = Trim(cumb.Offset(0, 17).Value)
GoTo hooray
End If
Set cumb = sh_.Cells.FindNext(after:=cumb)
Loop While Not cumb Is Nothing And cumb.Address <> first
End If
Next sh_
hooray:
Next i
End Sub

Beliebteste Forumthreads (12 Monate)

Forumthread: Wert suchen

1 Beitrag zum Forumthread Beitrag zu diesem Forumthread

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread