Find?  
Author Message
MikeFitz





PostPosted: Top

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("A3").Select ' pierwszy
kod odpadu
On Error Resume Next
ilosc = Workbooks("ODPADY.xls").Sheets("WEJSCIE").Range(Selection,
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("A3").Select ' pierwszy
kod odpadu
On Error Resume Next
ilosc = Workbooks("ODPADY.xls").Sheets("WEJSCIE").Range(Selection,
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

Excel171