Elektroda.pl
Elektroda.pl
X

Search our partners

Please add exception to AdBlock for elektroda.pl.
If you watch the ads, you support portal and users.

VBA, makro, excel wyszukiwanie komórek

traderr 05 Feb 2010 20:34 17672 17
  • #1
    traderr
    Level 9  
    Makro powinno przeszukać kolumnę C i jeżeli napotka słowo "dolek" to chciałbym, żeby w kolumnie D na wysokości danego "dolka" wstawiło liczbę stojącą w kolumnie B przy poprzednim "dolku".

    Chciałbym też żeby to makro albo drugie wstawiało kolumnę dalej wartość tylko takiego „dołka” przy którym wartość kolumny B jest mniejsza niż przy ostatnim „dołku”. (jeśli jest wyższa to szuka dalej)

    z góry dziękuję za pomoc

    pod linkiem zdjecie z excela

    VBA, makro, excel wyszukiwanie komórek
  • #2
    yogi009
    Level 43  
    Na pewno potrzeba tutaj makra ? Wystarczy w kolumnie D wpisać w komórki warunek... To na zaliczenia, czy coś konkretnego robisz ? Bo jak zaliczenie, to ja za nikogo lekcji nie odrabiam :-)
  • #3
    traderr
    Level 9  
    To nie jest na zaliczenie. To wygląda może prosto ale jest częścią większej całości, którą jestem w stanie sam zrobić. Problem w tym że dołki pojawiają się nieregularnie i koniecznie musi podawać wartość przedostatniego. Jeśli można to zrobić za pomocą funkcji to jeszcze lepiej.
  • #4
    yogi009
    Level 43  
    No to zastosuj tu funckcję jeżeli()

    w komórce D2 piszesz coś a'la: "jeżeli wartość w komórce B2 > 0 to tu wstaw wartość komórki B2"

    jeżeli(b2>0;b2) - piszę z pamięci, ale coś takiego

    No i teraz kopiujesz funkcję z D2 do wszystkich używanych komórek w kolumnie D. Można też sobie wymyślić, że jakaś kolumna (np. E) będzie "techniczna", tam można różne warunki "częściowe" sobie zapisać i rozwiązywać w ten sposób większe zapisy niejako "na raty" (nie zawsze optymalne od strony wydajności, ale zdecydowanie zwiększa czytelność algorytmu). Takie "techniczne kolumny zazwyczaj się potem ukrywa, żeby nas nie drażniły swoim wyglądem :-) Powodzenia.
  • #5
    traderr
    Level 9  
    przykro mi ale widzę że niedokładnie przeczytałeś mój opis potrzebuje żeby przy każdym kolejnym dołku wartość wstawiana była z komórki obok poprzedniego dołka.
  • Helpful post
    #6
    marcinj12
    Level 40  
    Makro wykonujące obydwie czynności może wyglądać np. tak:
    Code:

    Private Sub CommandButton1_Click()

    poprz_wartosc = Empty

    For Each c In ActiveSheet.Range("C1:C65536")    'tu można zawęzić przeszukiwany zakres
        If c = "dolek" Then
            ActiveSheet.Cells(c.Row, 4) = poprz_wartosc
           
            If Not IsEmpty(poprz_wartosc) And (ActiveSheet.Cells(c.Row, 2) < poprz_wartosc) Then
                ActiveSheet.Cells(c.Row, 5) = ActiveSheet.Cells(c.Row, 2)
            End If
           
            poprz_wartosc = ActiveSheet.Cells(c.Row, 2)
        End If
    Next c

    MsgBox "Koniec"
    End Sub

    Pozdrawiam
  • #7
    traderr
    Level 9  
    Super dziękuję za pomoc :) jak udało Ci się nauczyć VBA ? czy mógłbyś mi polecić jakąś książkę czy kurs ?
  • #8
    marcinj12
    Level 40  
    Cieszę się, że działa :)
    Ja akurat jestem samoukiem jeżeli chodzi o VBA - głównie szukałem google, nagrywałem makra i podglądałem kod w edytorze, no i trochę intuicji do tego :)
    Także książki konkretnej polecić nie potrafię, wpisz na google: vba kurs i wybierz sobie coś, co Ci się spodoba.
  • #9
    czesiu
    Level 35  
    Mnie bardzo pomogła :"Helion-John_Walkenbach-Excel2003PL_Programowanie_W_VBA_Vademecum_Profesjonalisty"
    którą kiedyś ściągnąłem z neta. Wykorzystałem bezpośrednio kilka kruczków, które były tam jasno opisane, a byłem wtedy w zasadzie początkującym. Chciałem ją sobie nawet kupić, ale w empiku mieli nowsze wydanie, które wg mnie jest o wiele gorsze i mniej czytelne.
  • #10
    traderr
    Level 9  
    Mam kolejne pytanie :), Posiadam zestaw plików około 200. Są w formacie "*.mst" umiem je otworzyć w excel i zapisać w formacie xls. Problem tylko w tym, że chciałbym napisać jakąś pętlę dzięki której, nie będę musiał wpisać oddzielnie formuł dla każdego pliku.

    Poniżej zamieszczam kod tam gdzie jest X mamy nazwy plików, które nie są zesobą jakoś powiązane. W sensie nie ma gradacji itp.

    Code:
    Workbooks.OpenText Filename:= _
    
            "K:\Moje Foldery\Pulpit\X.mst", Origin:=852, _
            StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
            ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=True, _
            Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1), Array( _
            3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1)), TrailingMinusNumbers:=True
     
        ActiveWorkbook.SaveAs Filename:= _
            "K:\Moje Foldery\Pulpit\xls\X.xls", FileFormat:= _
            xlExcel9795, Password:="", WriteResPassword:="", ReadOnlyRecommended:= _
            False, CreateBackup:=False
            ActiveWindow.Close

    z góry dziękuję za pomoc

    Proszę pamiętać o używaniu znaczników code. - arnoldziq
  • #11
    marcinj12
    Level 40  
    Tutaj masz przykład jak wylistować wszystkie pliki w katalogu... Tam gdzie masz pętlę wstaw swój fragment - oczywiście ze zmieniającą się nazwą pliku.
    Code:
    Private Sub CommandButton1_Click()
    
    Dim nextFile As String

    'sciezka do katalogu
    myDir = "C:\"

    'jakich plikow szukamy
    myFile = "*.txt"

    nextFile = Dir(myDir & myFile)

    Do Until Len(nextFile) = 0
       'w zmiennej nextFile mamy nazwę pliku
        Lista = Lista & nextFile & Chr(10)
        nextFile = Dir()
    Loop

    'wyswietla liste plikow w katalogu
    MsgBox "W katalogu " & myDir & " są następujące pliki:" & Chr(10) & Lista

    End Sub
  • #12
    traderr
    Level 9  
    ok problem tylko w tym, że chciałbym żeby automatycznie się zapisywał plik ten otwarty z formatu .mst w formacie excel. Tzn. żebym nie musiał wypisać 200 razy w środek pętli tego fragmentu, który poprzednio wkleiłem, z inną nazwą pliku za każdym razem.
  • #13
    adamas_nt
    Moderator of Programming
    Można po przeróbkach wykorzystać makro z tego tematu.

    Np coś w ten deseń
    Code:
    Sub dir_pliki()
    
    katalog = Application.DefaultFilePath & ""
    'katalog = "c:xxx" 'usuń pierwszą linię i wstaw po swojemu. musi być "" na końcu.
    plik = Dir(katalog & "*.xls") 'tu podstaw "*.mst"
    Do While plik <> ""
        If Right(plik, 3) = "xls" Then 'tu podstaw "*.mst"
           nazwa = Left(plik, (Len(plik) - 4))
           MsgBox "K:Moje FolderyPulpitxls" & nazwa & ".xls"
           'i tu Twoja procedura z wykorzystaniem zmiennych 'plik' i 'nazwa'
        End If
        plik = Dir
    Loop
    End Sub
  • #14
    traderr
    Level 9  
    przykro mi ale to nie działa:/
  • Helpful post
    #15
    adamas_nt
    Moderator of Programming
    Za to u mnie (z małymi przeróbkami) na plikach tekstowych (nie mam *.mst) działa.
    Code:
    Sub dir_pliki()
    
    'katalog = Application.DefaultFilePath & "\"
    'podstawiam Twój path
    katalog = "K:\Moje Foldery\Pulpit\"
    plik = Dir(katalog & "*.txt") 'tu podstaw "*.mst"
    Do While plik <> ""
        If Right(plik, 3) = "txt" Then 'tu podstaw "mst"
           nazwa = Left(plik, (Len(plik) - 4))
           
           Workbooks.OpenText Filename:= _
           katalog & plik, Origin:=852, _
           StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
           ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=True, _
           Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1), Array( _
           3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1)), TrailingMinusNumbers:=True
           
           ActiveWorkbook.SaveAs Filename:= _
           katalog & "xls\" & nazwa & ".xls", FileFormat:= _
           xlExcel8, Password:="", WriteResPassword:="", ReadOnlyRecommended:= _
           False, CreateBackup:=False
           'ActiveWindow.Close
           Workbooks(nazwa & ".xls").Close
        End If
        plik = Dir
    Loop
    End Sub
  • #16
    traderr
    Level 9  
    Dziękuję za ostatni kod bardzo mi pomógł. Mam jeszcze jedną pewnie ostatnią prośbę. Chciałbym że dla każdego pliku w katalogu po operacji zapisania pliku, excel sprawdził jedną kolumnę w której raz na jakiś czas pojawi się "+" i jeśli się pojawi to żeby nazwa pliku została zapisana do worda. (Tak żebym miał w wordzie na koniec listę plików w których jest "+").
    Kolumna, w której może się pojawić "+" jest zawsze ta sama. Ale za to w każdym pliku wiersz będzie inny. W pierwszej kolumnie będą podane daty. Chciałbym żeby dla każdego pliku excel sprawdził czy dla daty wczorajszej od dnia w której jest wykonywana operacja znajduje się "+".

    Z góry dziękuję za pomoc
  • #17
    adamas_nt
    Moderator of Programming
    Użyj dodatkowej pętli (przed zamknięciem pliku). Np
    Code:
    wrs = 1 'Nr pierwszego wiersza
    
    kolD = 1 'Nr kolumny z datą. Zakładam, że data w kol A, "+" w B (kolD + 1)

    Do While Cells(wrs, kolD) <> ""
      If Cells(wrs, kolD) = Date - 1 And Cells(wrs, kolD + 1) = "+" Then
        'tu kopiujesz nazwę pliku do Worda
        MsgBox ThisWorkbook.Name
      End If
      wrs = wrs + 1
    Loop
  • #18
    traderr
    Level 9  
    1. Prosiłbym jeszcze o wskazówkę jak skopiować nazwę pliku danego pliku excel do pliku word który będzie się nazywał "Lista_zbiorcza.doc"
    2. Czy udałoby się tak napisać kod żeby excel sprawdzał tylko wiersza z przedostatnią datą?