GoldenLine
Zaloguj się
Andrzej Rapp

Andrzej Rapp specjalista ds.
informatyki, Techem

Temat: Utworzenie funkcji wyszukaj pionowo w VBA

Chciałbym utworzyć funkcję wyszukaj pionowo z parametrami w VBA
Mam 2 arkusze.
Baza -zawiera numery kont przypisane do numerów oddziałów
Arkusz -zawiera numery kont oraz kwoty ale, brakuje numeru oddziału.

Samo wstawienie funkcji wyszukaj pionowo mi nic nie daje.
Potrzebuję to samo ale w języku VBA.
Próbowałem tworzyć makro ale w marko jest kod VLOOKUP a nie mam pojęcia jak zrobić z tej funkcji parametry.
Link do wypowiedziLink
Oskar Shon

Oskar Shon Dodatki do Office
www.VBATools.pl

Temat: Utworzenie funkcji wyszukaj pionowo w VBA

Odwołanie do Formuł w VBA realizujesz przez:
application.WorksheetFunction


No chyba że chcesz wpisać dalej jako formuła a więc jej treść musi być przekazana tak jak zwraca nagrywarka (czyli tekstem).

Załącz przykład bo może źle się do tego zabierasz albo kolejność danych nie spełnia warunków formuły i należy użyć kombinacji Index i Podaj.pozycje
Link do wypowiedziLink
Andrzej Rapp

Andrzej Rapp specjalista ds.
informatyki, Techem

Temat: Utworzenie funkcji wyszukaj pionowo w VBA

Mam kod Makra następujący:

Sub wyszukaj()
'
' wyszukaj Makro
'

'
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-3],BAZA!C[-3]:C[-2],2,0)"
Selection.AutoFill Destination:=Range("D2:D9"), Type:=xlFillDefault
Range("D2:D9").Select
Range("D10").Select
End Sub

Wolałbym żeby to była funkcja czyli po

Sub wyszukaj( Od as Range, Do as Range , kol as Long, Warunek as boolean )
Link do wypowiedziLink
Oskar Shon

Oskar Shon Dodatki do Office
www.VBATools.pl

Temat: Utworzenie funkcji wyszukaj pionowo w VBA

W polskim tłumaczeniu jest mała nieścisłość.
Formułą określa się polecenie wpisane bezpośrednio w Arkusz (w tym zastosowanie .FormulaR1C1) a funkcją komendę VBA w tym przypadku application.WorksheetFunction.VLookup(parametry)
Link do wypowiedziLink
Andrzej Rapp

Andrzej Rapp specjalista ds.
informatyki, Techem

Temat: Utworzenie funkcji wyszukaj pionowo w VBA

Znalazłem następujący kod na angielskiej stronie.

Sub ADDCLM()
On Error Resume Next
Dim Dept_Row As Long
Dim Dept_Clm As Long
Table1 = Sheet1.Range("A3:A13") ' Employee_ID Column from Employee table
Table2 = Sheet1.Range("H3:I13") ' Range of Employee Table 1
Dept_Row = Sheet1.Range("E3").Row ' Change E3 with the cell from where you need to start populating the Department
Dept_Clm = Sheet1.Range("E3").Column
For Each cl In Table1
Sheet1.Cells(Dept_Row, Dept_Clm) = Application.WorksheetFunction.VLookup(cl, Table2, 2, False)
Dept_Row = Dept_Row + 1
Next cl
MsgBox "Done"
End Sub

Przerobiłem go do swoich potrzeb i w sumie działa ale muszę go zautomatyzować czyli wprowadzić zmienne Row, Column dla Table 1 i Table 2.
Docelowo funkcja ma sprawdzać wiersz po wierszu ale tez zamonitować gdy się okaże ze jest nowe konto, które nie jest uwzględnione w tabeli Baza
Link do wypowiedziLink
Oskar Shon

Oskar Shon Dodatki do Office
www.VBATools.pl

Temat: Utworzenie funkcji wyszukaj pionowo w VBA

Czyli z tego rozumiem że sobie już poradzisz, a podpowiedź ruszyła cię z miejsca?
Link do wypowiedziLink
Andrzej Rapp

Andrzej Rapp specjalista ds.
informatyki, Techem

Temat: Utworzenie funkcji wyszukaj pionowo w VBA

Sub Validation2_Pol()
validationresult = True
ColumnsCheck = True
CostCenterCheck = True
Dim Dest_Row As Long
Dim Dest_Clm As Long
r1 = 2
k1 = 1
While Not IsEmpty(Cells(r1, k1))
If Len(Cells(r1, k1)) <> 9 Then
validationresult = False
Else
Table1 = Sheets("Arkusz").Range(Cells(r1, k1))
Table2 = Sheets("BAZA").Range("A2:B234") ' Zakres wyszukiwania
Dest_Row = Sheets("Arkusz").Range("C3").Row ' Podajemy wiersz w ktorej pojawi sie kod oddzialu
Dest_Clm = Sheets("Arkusz").Range("C234").Column ' Podajemy kolumne
Wend
For Each cl In Table1
Sheets("Arkusz").Cells(Dest_Row, Dest_Clm) = Application.WorksheetFunction.VLookup(cl, Table2, 2, False)
'MsgBox ("wiersz " & Dest_Row)
Dest_Row = Dest_Row + 1
r1 = r1 + 1
Next cl
MsgBox "Done"

Nie do końca właśnie szukam rozwiązania i coś mi nie wychodzi gdy są pętle.
Niestety nie znam dobrze VBA.
Link do wypowiedziLink
Oskar Shon

Oskar Shon Dodatki do Office
www.VBATools.pl

Temat: Utworzenie funkcji wyszukaj pionowo w VBA

Sporządź przykładowy plik w którym dane będą odpowiadać rzeczywistości i wyślij linka (tylko proszę nie do jakiegoś śmieciowego serwera, tylko np spakowany zipem Onedrv/Googledrv lub Dropbox). To jak znajdę czas to sprawdzę na konkretnym przykładzie.

Drogą do sukcesu jest nie tylko użycie metod, ale również i poprawna deklaracja.
Wymusisz ją wpisując w nodule w pierwszej linijce taką komendę:
Option Explicit
Link do wypowiedziLink
Andrzej Rapp

Andrzej Rapp specjalista ds.
informatyki, Techem

Temat: Utworzenie funkcji wyszukaj pionowo w VBA

https://www.dropbox.com/s/q448w7uzpir35yh/Wyszukaj.xls?...

Udało mi się z tym poradzić jednak nie mogę zrobić w VBA żeby funkcja wyszPion się zatrzymała.
Link do wypowiedziLink
Oskar Shon

Oskar Shon Dodatki do Office
www.VBATools.pl

Temat: Utworzenie funkcji wyszukaj pionowo w VBA

Nie rozumiem.
Pętlę masz For Each a więc w granicy zakresu.
Zakres dajesz 
ActiveSheet.Range("A2:A17")

a więc 16 komórek.

Zamienna Row i jej iteracja jest tam nie potrzebna (zresztą nazwa zastrzeżona nie powinieneś tak używać), ale to akurat nie przeszkadza. Zapewne zrobiłeś go do sprawdzenia czy wartośc nie jest pusta. Trochę źle bo zamiast
If Not IsEmpty(ActiveSheet.Cells(Row, 1)) Then
powinno być w pętli a nie poza nią tak:


Sub zz()

Sheets("Arkusz").Select

Dim rngTmp As Range:    Set rngTmp = Sheets("Baza").Range("A2:B17")

Dim szukana As Range:   Set szukana = ActiveSheet.Range("A2:A17")

For Each cl In szukana

    If Len(cl) > 0 Then _

        cl.Offset(, 1).Value = WyszPion(cl.Value, rngTmp, 2, False)

Next

End Sub

Odpalasz i działa.
Link do wypowiedziLink
« Wróć do tematów
Odpowiedz

Podobne tematy





Wyślij zaproszenie do
Anuluj