Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
648to652
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
648to652
648to652
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

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
  • 09.08.2005 15:53:17
    Alexej
Anzeige
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

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige