Elektroda.pl
Elektroda.pl
X
Proszę, dodaj wyjątek dla www.elektroda.pl do Adblock.
Dzięki temu, że oglądasz reklamy, wspierasz portal i użytkowników.

VBA excel - makro - pomoc w napisaniu odpowiedniej formuły

18 Kwi 2010 13:13 3674 9
  • Poziom 9  
    Hej,

    Czy ktoś może mi pomóc w napisaniu makra, które przeszukując kolumny A i B (A1, B1, A2, B2 itd ) odnajdzie wszystkie słowa zaczynające się na ak..., ab..., al..., at... i przekopiuje je w takiej kolejności jak się pojawiły do nowego arkusza?

    Pozdrawiam
    Darmowe szkolenie: Ethernet w przemyśle dziś i jutro. Zarejestruj się za darmo.
  • Poziom 42  
    Jeśli masz tych wzorców kilka (np. 4), nie ma potrze by stosowania makr, wystarczy kilka funkcji (logicznych i tekstowych), w następnym kroku (np. na następnym arkuszu) wyniki możesz zebrać tak, aby nie było między nimi pustych wierszy - takie zapisy pojawiały się już na Elektrodzie - z tego, co pamiętam ostatni ok. 2 miesięcy temu.
  • Poziom 9  
    Dzięki za odpowiedź. Niestety mój problem to tylko część większej całości dlatego istnieje konieczność użycia makra.
  • Poziom 13  
    Nie wiem jaka jest Twoja wiedza w VBA i czy oczekujesz gotowego rozwiązania czy algorytmu, ale mimo wszystko dobrze byłoby jeszcze sprecyzować:

    1. Czy po przekopiowaniu do nowego arkusza wszystkie takie łańcuchy tekstowe mają znaleźć się w jednej kolumnie?
    2. Czy nowy arkusz będzie zdefiniowany(nazwa), czy za każdym razem kiedy takie makro będzie wywoływane ma być tworzony taki arkusz?

    Pozdrawiam
  • Poziom 9  
    Hej,

    Odnośnie VBA - znam podstawy, ale się uczę cały czas :)

    Ad.1.
    Tak w jednej kolumnie i tak jak pisałam kolejność przeglądania A1, B1, A2, B2 ... i to co będzie odpowiadało warunkom kopiujemy do jednej kolumny, jedno pod drugim.
    Ad.2.
    Nowy arkusz będzie zdefiniowany (nazwa - PORÓWNANIE).
  • Pomocny post
    Poziom 13  
    Proponuję coś takiego

    Code:

    Sub Porownaj()
       
        Const PWiersz As Long = 1
        Dim IleWierszyA As Long
        Dim IleWierszyB As Long
        Dim IleWierszy
        Dim I As Long, J As Long
        Dim BWiersz As Long
        Dim BArk As String
        Dim CArk As String
       
        BArk = ActiveSheet.Name 'Zapamiętanie nazwy arkusza w którym są dane
       
        IleWierszyA = ActiveSheet.Cells(65535, 1).End(xlUp).Row 'wyznaczenie ilości wypełnionych wierszy w kolumnie A
        IleWierszyB = ActiveSheet.Cells(65535, 2).End(xlUp).Row 'wyznaczenie ilości wypełnionych wierszy w kolumnie B
       
    'Ustalenie największej ilości wierszy   
        If IleWierszyA >= IleWierszyB Then
            IleWierszy = IleWierszyA
        Else
            IleWierszy = IleWierszyB
        End If
       
        CArk = "Porównanie"
        J = 1
    'Przeszukanie wszystkich wierszy   
    For I = PWiersz To IleWierszy
            If Left(Worksheets(BArk).Cells(I, 1), 2) = "ak" Or Left(Worksheets(BArk).Cells(I, 1), 2) = "ab" Or Left(Worksheets(BArk).Cells(I, 1), 2) = "al" Or Left(Worksheets(BArk).Cells(I, 1), 2) = "at" Then
                Worksheets(CArk).Cells(J, 1) = Worksheets(BArk).Cells(I, 1)
                J = J + 1
            End If
            If Left(Worksheets(BArk).Cells(I, 2), 2) = "ak" Or Left(Worksheets(BArk).Cells(I, 2), 2) = "ab" Or Left(Worksheets(BArk).Cells(I, 2), 2) = "al" Or Left(Worksheets(BArk).Cells(I, 2), 2) = "at" Then
                Worksheets(CArk).Cells(J, 1) = Worksheets(BArk).Cells(I, 2)
                J = J + 1
            End If
        Next I
    End Sub


    Jeśli jakieś łańcuchy się będą powtarzać, to w arkuszu "Porównanie" też się będą powtarzać, ale da się to wyeliminować
    Jeśli masz jakiekolwiek pytania, nawet takie, które wydawać by się mogły głupie, to pytaj. Jeśli będę znał odpowiedź, to odpowiem

    Pozdrawiam
  • Poziom 9  
    Hej,

    Super działa :) Jestem bardzo wdzięczna.

    A wiesz może jak porównywać zawartość dwóch kolumn i kolorować np. na zielono to, co znajduje się w obu (np. w A i C), na czerwono to, co jest np tylko w kolumnie A a na niebiesko to co występuje tylko w C.
    W obu kolumnach znajdują się kody jakiś produktów, a zadanie polega a tym, żeby sprawdzić czy zawartość obu kolumn jest taka sama, ewentualnie wykrycie błędów i ich kolorystyczne oznaczenie. Kolejność w kolumnach jest całkowicie przypadkowa.

    Pozdrawiam ciepło.
  • Pomocny post
    Poziom 13  
    Przepraszam, że z takim opóźnieniem odpisuję, ale wcześniej nie było możliwości.

    Poniższy kod na sztywno porównuje 2 kolumny (pierwszą i drugą), ale równie dobrze zamiast procedurki (Sub), można zrobić funkcję (Function), która będzie miała dwa argumenty określające numery kolumn (albo literki kolumn).
    Przy większej ilości wierszy, wykonanie porównania może zająć dość sporo czasu, bo nie jest to optymalne rozwiązanie, ale na szybko coś takiego przyszło mi do głowy.

    Code:

    Sub PorownajKol()
        Dim IleWierszy1 As Long
        Dim IleWierszy2 As Long
        Dim I As Long
        Dim J As Long
        Dim Kol1 As Integer
        Dim Kol2 As Integer
        Dim BArk As String
        Dim FlagaPowt As Boolean
       
    'Zapamiętanie w zmiennej nazwy bieżącego arkusza
        BArk = ActiveSheet.Name
    'Określenie numerów kolumn - mogą to być argumenty funkcji (zamiast Sub na początku to Function)
        Kol1 = 1    'kolumna A
        Kol2 = 2    'kolumna B
       
    'Wyznaczenie ilości wierszy w wybranych kolumnach
        IleWierszy1 = Worksheets(BArk).Cells(65535, Kol1).End(xlUp).Row
        IleWierszy2 = Worksheets(BArk).Cells(65535, Kol2).End(xlUp).Row
       
    'Porównanie obu kolumn wiersz po wierszu
        For I = 1 To IleWierszy1
    'Wstępne wyzerowanie flagi powtórzenia zawartości w obu kolumnach
            FlagaPowt = False
            For J = 1 To IleWierszy2
                If Worksheets(BArk).Cells(I, Kol1) = Worksheets(BArk).Cells(J, Kol2) Then
                    Worksheets(BArk).Cells(I, Kol1).Interior.Color = vbGreen
                    Worksheets(BArk).Cells(J, Kol2).Interior.Color = vbGreen
                    FlagaPowt = True
                Else
                    If FlagaPowt = False Then
                        Worksheets(BArk).Cells(I, Kol1).Interior.Color = vbRed
                    End If
                    If Worksheets(BArk).Cells(J, Kol2).Interior.Color <> vbGreen Then
                        Worksheets(BArk).Cells(J, Kol2).Interior.Color = vbBlue
                    End If
                End If
            Next J
        Next I
    End Sub
  • Poziom 1  
    WITAM!!

    Bardzo prosze o pomoc w napisaniu makra:
    musi zawierać ono 3 przyciski (yesNoCancel) oraz ikonę ostrzeżenia. musi wyswietlac zapytanie "czy kolor obramowania aktywnej komórki ma być czerwony a wnętrza niebieski"
    TAK- obramowanie czerwone, wypełnienie niebieskie
    NIE- nic

    musi to dzialac w excelu 2010 VB...
    wogole sie na tym nie znam- dla tego prosze o pomoc, i to expresową termin goni.