Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Find?
I have 2 PLIKI. odpady.xls and wsk.xls. In file odpady.xls are field ID (col"And")=Status (col"B")=Name (col"C") .....and theof MPK(of the column the "L") In file odpady.xls are field: ID (col"A") Name (col"B").... the and of MPK ( the column the "H") ID - number does not repeat oneself Procedure SEARCH (FIND) the most interests me. I do not know where ID is - that i must search in every sheets. I have in file odpady.xls button I want to: IF (ID (from wastes.xls)) = (ID (from wsk.xls)) and Status ="N" Then the column "H" MPK(from odpady.xls) = MPK (from wsk.xls) I tried finding... but something not to end work me. Private Sub CommandButton6_Click() ' import MPK z WSK.xls 'Dim zm As Workbook Dim wsk As Workbook Dim NAZWA As String Dim i, ilosc, wiersz, rowId As Integer Dim ile As Integer Dim sh As Worksheet Dim sh1 As Worksheet Dim szukana As Range Dim firstAddress As Integer On Error Resume Next Set wsk = Workbooks("WSK.xls") On Error GoTo 0 If wsk Is Nothing Then 'Set wsk = Workbooks.Open(Filename:="D:\!Projekty_WSK\Odpady\ NEW\WSK.xls") ' komunikat ze nie otworzony plik If MsgBox("Musisz mieć otworzony plik WSK.xls !!! ", vbExclamation, "UWAGA!!!") = vbOK Then Exit Sub End If Workbooks("ODPADY.xls").Activate Workbooks("ODPADY.xls").Sheets("WEJSCIE").Select 'Application.EnableEvents = False Workbooks("ODPADY.xls").Sheets("WEJSCIE").Range("A 3").Select ' pierwszy kod odpadu On Error Resume Next ilosc = Workbooks("ODPADY.xls").Sheets("WEJSCIE").Range(Se lection, Selection.End(xlDown)).Count ' policz ile wpisów If IsError(ilosc) Then ilosc = 0 For i = 3 To ilosc + 3 ' od pierwszej komórki z kodem odpadu do ostatniej Workbooks("ODPADY.xls").Sheets("WEJSCIE").Activate Workbooks("ODPADY.xls").Sheets("WEJSCIE").Select 'Workbooks("ODPADY.xls").Sheets("WEJSCIE").Cells(i , 2).Select ' pierwsza komorka z 2 kryterium If Workbooks("ODPADY.xls").Sheets("WEJSCIE").Cells(i, 4) = "" Then Exit Sub If Workbooks("ODPADY.xls").Sheets("WEJSCIE").Cells(i, 3) = "N" Then If Workbooks("ODPADY.xls").Sheets("WEJSCIE").Cells(i, 2) = "T" Then 'Workbooks("ODPADY.xls").Sheets("WEJSCIE").Cells(i , 1).Select NAZWA = Sheets("WEJSCIE").Cells(i, 1) ' unikalne ID If (NAZWA < "") And (Workbooks("ODPADY.xls").Sheets("WEJSCIE").Cells(i , 6) = "WSK") Then Set sh1 = wsk.Worksheets(wsk.Worksheets.Count) For Each sh In wsk.Worksheets Set szukana = sh.Cells.Find(What:=NAZWA, _ After:=sh.Range("A1"), LookIn:=xlValues, _ LookAt:=xlPart, SearchOrder:=xlByColumns, _ SearchDirection:=xlNext, MatchCase:=False) ' pętla dopuki nie znajdzie If szukana < NAZWA Then 'firstAddress = szukana.Address Do 'If szukana < NAZWA Then 'szukana.Interior.Pattern = xlPatternGray50 Set szukana = sh.Cells.FindNext(szukana) Loop While Not szukana Is Nothing And szukana.Address < firstAddress End If If szukana Is Nothing Then If sh.Name = sh1.Name Then 'MsgBox "Szukana """ & NAZWA & """ nie została odnaleziona" 'wsk.Close 'Application.EnableEvents = True ' REACTIVATE EVENTS Exit For End If Else 'If szukana = NAZWA Then wsk.Activate sh.Activate szukana.Activate rowId = sh.Range(szukana.Address).row MsgBox "Szukana cecha """ & NAZWA & """ została odnaleziona" Workbooks("ODPADY.xls").Sheets("WEJSCIE").Cells(i, 12) = sh.Cells(rowId, 8) Workbooks("ODPADY.xls").Sheets("WEJSCIE").Cells(i, 3) = "T" Exit For End If 'Application.EnableEvents = True ' REACTIVATE EVENTS 'wsk.Close 'ActiveCell.Value = Cecha 'End If Next sh End If End If End If Next i end Sub OR Private Sub CommandButton6_Click() ' import MPK z WSK.xls 'Dim zm As Workbook Dim wsk As Workbook Dim NAZWA As String Dim i, ilosc, rowId As Integer 'Dim ile As Integer Dim sh As Integer Dim sh1 As Integer Dim szukana As Range 'Dim FirstAdress As Integer Dim FirstAddress As String On Error Resume Next Set wsk = Workbooks("WSK.xls") On Error GoTo 0 If wsk Is Nothing Then 'Set wsk = Workbooks.Open(Filename:="D:\!Projekty_WSK\Odpady\ NEW\WSK.xls") ' komunikat ze nie otworzony plik If MsgBox("Musisz mieć otworzony plik WSK.xls !!! ", vbExclamation, "UWAGA!!!") = vbOK Then Exit Sub End If Workbooks("ODPADY.xls").Activate Workbooks("ODPADY.xls").Sheets("WEJSCIE").Select Workbooks("ODPADY.xls").Sheets("WEJSCIE").Range("A 3").Select ' pierwszy kod odpadu On Error Resume Next ilosc = Workbooks("ODPADY.xls").Sheets("WEJSCIE").Range(Se lection, Selection.End(xlDown)).Count ' policz ile wpisów If IsError(ilosc) Then ilosc = 0 For i = 3 To ilosc + 3 ' od pierwszej komórki z kodem odpadu do ostatniej Workbooks("ODPADY.xls").Sheets("WEJSCIE").Activate Workbooks("ODPADY.xls").Sheets("WEJSCIE").Select 'Workbooks("ODPADY.xls").Sheets("WEJSCIE").Cells(i , 2).Select ' pierwsza komorka z 2 kryterium If Workbooks("ODPADY.xls").Sheets("WEJSCIE").Cells(i, 4) = "" Then Exit Sub If Workbooks("ODPADY.xls").Sheets("WEJSCIE").Cells(i, 3) = "N" Then If Workbooks("ODPADY.xls").Sheets("WEJSCIE").Cells(i, 2) = "T" Then 'Workbooks("ODPADY.xls").Sheets("WEJSCIE").Cells(i , 1).Select NAZWA = Sheets("WEJSCIE").Cells(i, 1) ' unikalne ID End If End If sh1 = wsk.Sheets.Count If (NAZWA < "") And (Workbooks("ODPADY.xls").Sheets("WEJSCIE").Cells(i , 6) = "WSK") Then 'Set sh1 = wsk.Worksheets(wsk.Worksheets.Count) 'For sh = 1 To sh1 ' Set szukana = wsk.Sheets(sh).Cells.Find(What:=NAZWA, _ ' After:=Sheets(sh).Range("A1"), LookIn:=xlValues, _ ' LookAt:=xlPart, SearchOrder:=xlByColumns, _ ' SearchDirection:=xlNext, MatchCase:=False) ' FirstAddress = szukana.Address 'Do While (szukana < NAZWA) ' Set szukana = Sheets(sh).Cells.FindNext(szukana) ' If szukana.Address = FirstAddress Then ' Exit Do 'End If 'Loop For K = i To wsk.Worksheets.Count With wsk.Worksheets(K).Range("a1:a500") Set szukana = .Find(NAZWA, LookIn:=xlValues) If Not szukana Is Nothing Then FirstAddress = szukana.Address Do 'MsgBox "Szukana cecha """ & NAZWA & """ została odnaleziona" 'szukana.Value = 5 Set szukana = .FindNext(szukana) If szukana = NAZWA Then MsgBox "Szukana cecha """ & NAZWA & """ została odnaleziona" rowId = Sheets(sh).Range(szukana.Address).row MsgBox "Szukana cecha """ & NAZWA & """ została odnaleziona" Workbooks("ODPADY.xls").Sheets("WEJSCIE").Cells(i, 12) = Worksheets(K).Cells(rowId, 8) Workbooks("ODPADY.xls").Sheets("WEJSCIE").Cells(i, 3) = "T" Exit For End If Loop While Not szukana Is Nothing And szukana.Address < FirstAddress End If End With Next K 'If (szukana Is Nothing) And (Sheets(sh).Name = Sheets(sh1).Name) Then 'Exit For 'Else 'wsk.Activate 'Sheets(sh).Activate 'szukana.Activate 'rowId = Sheets(sh).Range(szukana.Address).row 'MsgBox "Szukana cecha """ & NAZWA & """ została odnaleziona" 'Workbooks("ODPADY.xls").Sheets("WEJSCIE").Cells(i , 12) = Sheets(sh).Cells(rowId, 8) 'Workbooks("ODPADY.xls").Sheets("WEJSCIE").Cells(i , 3) = "T" 'Exit For 'End If 'Next sh End If Next i End Sub |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Find First Non blank cell than find column header and return that value | Excel Worksheet Functions | |||
Despite data existing in Excel 2002 spreadsheet Find doesn't find | Excel Discussion (Misc queries) | |||
find and delete duplicate entries in two columns or find and prin. | Excel Programming | |||
find and delete text, find a 10-digit number and put it in a textbox | Excel Programming | |||
backwards find function to find character in a string of text | Excel Programming |