napisał: Tremor
postów: 5
 umieszczony:
11 maja 2005
00:17
|
|
| Taki temat robi się w Accesie najwygodniej.... |
|
|
napisał: pil
postów: 154
umieszczony:
21 marca 2005
11:33
|
|
Tak może wyglądać procedura, która porównuje pierwsze kolumny z dwóch różnych plików :
Option Explicit
Public Sub PorownajPlikZrodla()
Dim skoroszyt As Workbook
Dim strPath, strFileName As String
Dim tempVal As String
Dim i, j As Integer
i = 1 'wartosc startowa licznika
strPath = ThisWorkbook.Path 'sciezka do pliku, oba pliki muszą znajdować się w tym samym katalogu
strFileName = InputBox("Podaj nazwę pliku źródłowego (bez rozszerzenia): ") 'nazwa pliku od użytkownika
strFileName = strFileName & ".xls" 'dodanie rozszerzenia do nazwy pliku
strPath = strPath & "\" & strFileName 'nazwa pliku ze sciezka
Set skoroszyt = Workbooks.Open(strPath) 'otwarcie pliku
Do While ThisWorkbook.Worksheets("Arkusz1").Cells(i, 1).Value <> "" 'dziala dopoki nie napotka na pusta komorke
tempVal = ThisWorkbook.Worksheets("Arkusz1").Cells(i, 1).Value
j = 1
Do While skoroszyt.Worksheets("Arkusz1").Cells(j, 1).Value <> ""
If tempVal = skoroszyt.Worksheets("Arkusz1").Cells(j, 1).Value Then
ThisWorkbook.Worksheets("Arkusz1").Cells(i, 3).Value = skoroszyt.Worksheets("Arkusz1").Cells(j, 1).Value
ThisWorkbook.Worksheets("Arkusz1").Cells(i, 4).Value = skoroszyt.Worksheets("Arkusz1").Cells(j, 2).Value
Exit Do 'opuszczenie petli jezeli wystąpila taka sama wartosc - tylko po to, zeby makro działało żwawiej
End If
j = j + 1
Loop
i = i + 1
Loop
skoroszyt.Close
End Sub
Powodzenia |
|
|
napisał: kasia100
postów: 6
umieszczony:
21 marca 2005
10:12
|
|
| czy nie prosciej zastosowac funkcje excela "wyszukaj pionowo"? |
|
|
napisał:  admin
postów: 613
umieszczony:
10 marca 2005
21:15
|
|
| Działa? |
|
|
napisał: admin
postów: 613
umieszczony:
8 marca 2005
20:22
|
|
| Cytat: Tak aktualne, jeśli możesz mi pomóc, to byłbym bardzo wdzięczny.
Oto i moja propozycja.
poniżej numer konta;)
Sub ZnajdzDuplikaty()
'deklaracje
Dim oWbk As Workbook
Dim oW1 As Worksheet
Dim oW2 As Worksheet
'Tu wpisz nazwy Twojego skoroszytu i arkuszy
Set oWbk = Workbooks("Duplikaty.xls")
'pierwszy
Set oW1 = oWbk.Worksheets("A")
'drugi
Set oW2 = oWbk.Worksheets("B")
Dim i As Long, j As Long
i = 1
Do While oW1.Range("A" & i).Value <> ""
j = 1
Do While oW2.Range("A" & j).Value <> ""
If oW2.Range("A" & j).Value = oW1.Range("A" & i).Value Then
oW1.Range("C" & j).Value = oW2.Range("A" & i).Value
oW1.Range("D" & j).Value = oW2.Range("B" & i).Value
End If
j = j + 1
Loop
i = i + 1
Loop
'zwalnianie pamieci zajętej przez zmienne obiektowe
Set oW2 = Nothing
Set oW1 = Nothing
Set oWbk = Nothing
End Sub |
|
|
napisał: daromaster
postów: 2
umieszczony:
7 marca 2005
11:04
|
|
| Tak aktualne, jeśli możesz mi pomóc, to byłbym bardzo wdzięczny. |
|
|
napisał: admin
postów: 613
umieszczony:
2 marca 2005
19:11
|
|
| Aktualne jeszcze? |
|
|
napisał: daromaster
postów: 2
umieszczony:
17 lutego 2005
09:42
|
|
Witam.
Spotkałem się ostatnio z takim oto problemem:
W 1 skoroszycie, w którym mam 2 kolumny: w kolumnie A znajduje się identyfikator wiersza w postaci kodu typu - OKA0101022 - a w kolumnie B krótki opis produktu przypisanego do tego kodu. Wierszy jest dużo - jakieś 8000.
W 2 skoroszycie, w też mam 2 kolumny - w kolumnie A kod, a w kolumnie B opis - wierszy podobna ilość, lecz kody w kolumnie A są w większości takie same jak w kolumnie A skoroszytu nr 1, ale kilkaset jest innych.
Chodzi mi o to, czy można napisać takie makro, które:
pobierze z kolumny A i B (oczywiście patrząc po A) te wiersze ze skoroszytu nr 2, które mają identyczny kod jak te w kolumnie A skoroszytu nr 1, i przeniesie je w niezmienionej formie do skoroszytu nr 1 i wstawi je do kolumny C i D - tak żeby te same wiersze leżały obok siebie - nieprzypisane wiersze w skoroszycie nr 1 pozostaną puste w kolumnach C i D.
Oczekuję na pomoc, z góry badzo dziękuję
Pozdrawiam
Darek |
|
|
 wstecz 1 dalej  wszystkich stron: 1
|
