#1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 20
Default 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
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
Find First Non blank cell than find column header and return that value Silver Rose Excel Worksheet Functions 10 April 30th 07 05:56 PM
Despite data existing in Excel 2002 spreadsheet Find doesn't find AnnieB Excel Discussion (Misc queries) 1 June 16th 06 02:15 AM
find and delete duplicate entries in two columns or find and prin. campare 2 columns of numbers-find unique Excel Programming 1 November 24th 04 04:09 PM
find and delete text, find a 10-digit number and put it in a textbox Paul Excel Programming 3 November 16th 04 04:21 PM
backwards find function to find character in a string of text Ashleigh K. Excel Programming 1 January 14th 04 04:36 PM


All times are GMT +1. The time now is 12:40 PM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"