Excel Forum - Porady, Pomoc, Excel Help, Excel FAQ - wyniki w wierszu .1

mar1980 · Fan Excela Posty: 99

Czesc

Mam problem z dokończenie swoich wypocin w vba a mianowicie nie wiem jak zadeklarowac aby dana "ter" pojawiała sie zawsze w rekordzie .1 polu T1 jesli wystapi drugi raz w zakresie od .1 do .1 (kolumna A) to ma zostac zapisana w kolumnie T2.

Kod:

Sub ar()
Dim x As Integer
Dim cable As Integer
Dim ostA As Long

ostA = Cells(Rows.Count, "A").End(xlUp).Row

For x = 1 To ostA
cabel = Mid(Cells(x, 5), 1, 3)
If Cells(x, 1).Value = ".1" Then
Cells(x, 9).Value = Cells(x, 5)
ElseIf Cells(x, 1).Value = "..2" And cabel = "CAB" Then
Cells(x - 1, 10).Value = Cells(x, 4)
Cells(x - 1, 11).Value = Cells(x, 6)
ElseIf Cells(x, 1).Value = "..2" And cabel = "TER" Then
Cells(x - 2, 12).Value = Cells(x, 4)
End If
Next
End Sub

Dzieki

Pozdrawiam

przykłąd.rar

Pobierz Plik ściągnięto 11 raz(y) 18.07 KB

Aquaman · Fan Excela **Pomógł:** 29 razy Posty: 69

Nie wiem, czy poniższy kod rozwiąże twój problem. Warunki, które przedstawiłeś w pliku nie są dla mnie jasne w porównaniu z przykładem. M.in., np. ASM TERM M 0.64 RH SN SEALED nie jest brane pod uwagę, chociaż zawiera TERM i SEAL? W kodzie używasz CABL, w warunkach o tym nie wspominasz... Generalnie mam wątpliwości co i gdzie powinno się kopiować.

Kod:

Option Explicit
Sub test()
Dim i As Long, j As Long, s As Long, t As Long, ostA As Long
Dim opt(3) As Long ' indeks: 0 dla "CABL", 1 dla "SEAL", 2 dla "TERM"
'Dim tmp As String ' = ..., "CABL", "SEAL", "TERM", ...

i = 1
ostA = Cells(Rows.Count, "A").End(xlUp).Row
Do While i < ostA
i = i + 1
'Cells(i, 1).Select
If Cells(i, 1) = ".1" And UCase(Left(Cells(i, 5), 2)) = "DR" Then
Cells(i, 9) = Cells(i, 5)
Cells(i, 10) = Cells(i, 4)
Cells(i, 11) = Cells(i, 6)
For j = 1 To 3
opt(j - 1) = 0 ' zerowanie liczników
Next j
j = i ' zapamiętujemy wiersz wpisywanych danych
Do Until Cells(i + 1, 1) = ".1" Or i > ostA
i = i + 1
If Cells(i, 1) = "..2" Then
'InStrRev(UCase(Cells(i, 5)), tmp)
Select Case UCase(Left(Cells(i, 5), 4))
Case "CABL"
Case "SEAL"
Cells(j, 13 + opt(1)) = Cells(i, 4)
opt(1) = opt(1) + 2
Case "TERM"
Cells(j, 12 + opt(2)) = Cells(i, 4)
opt(2) = opt(2) + 2
End Select
End If
'Cells(i, 1).Select
Loop
End If
Loop
End Sub

Odnośnie twojego kodu, to chyba najprościej byłoby, gdybyś zapamiętał w jakieś zmiennej numer wiersza w którym chcesz wpisać wartości. A dla "duplikowanych" wartości dodał jakieś liczniki jako przesunięcie kolumny (o 0 /*T1, S1*/ lub 2 /*T2, S2*/ kolumny).

mar1980 · Fan Excela Posty: 99

Czesc Aquaman

Popierwsze to dzieki za pomoc. Na czerwono pozwoliłem sobie naniesc małe poprawki:

Kod:

Sub test()
Dim i As Long, j As Long, s As Long, t As Long, ostA As Long
Dim opt(3) As Long ' indeks: 0 dla "CABL", 1 dla "SEAL", 2 dla "TERM"
'Dim tmp As String ' = ..., "CABL", "SEAL", "TERM", ...

i = 1
ostA = Cells(Rows.Count, "A").End(xlUp).Row
Do While i < ostA [color=red]'warunek (instrukcje sa wykonywane dopóki jest spełniony warunek musi byc TRUE)[/color]
i = i + 1
'Cells(i, 1).Select
If Cells(i, 1) = ".1" And UCase(Left(Cells(i, 5), 2)) = "DR" Then
Cells(i, 9) = Cells(i, 5)
Cells(i, 10) = [color=red]Cells(i + 1, 4)[/color]
Cells(i, 11) = [color=red]Cells(i + 1, 6)[/color]
For j = 1 To 3
opt(j - 1) = 0 ' zerowanie liczników
Next j
j = i ' zapamiętujemy wiersz wpisywanych danych
Do Until Cells(i + 1, 1) = ".1" Or i > ostA [color=red]'warunek (instrukcje sa wykonywane dopóki jest spełniony warunek musi byc FALSE)[/color]
i = i + 1
If Cells(i, 1) = "..2" Then
'InStrRev(UCase(Cells(i, 5)), tmp)
Select Case UCase(Left(Cells(i, 5), 4))
'[color=red]Case "CABL"[/color]
Case "SEAL"
Cells(j, 13 + opt(1)) = Cells(i, 4)
opt(1) = opt(1) + 2
Case "TERM"
Cells(j, 12 + opt(2)) = Cells(i, 4)
opt(2) = opt(2) + 2
End Select
End If
'Cells(i, 1).Select
Loop
End If
Loop
End Sub

Aquaman mógłbys mi wyjasnic na chłopski rozum dlaczego pierwsze korzystasz z petli Do While a potem Do Until?

Poza tym w ogóle nie kumam zerowania licznika w tej petli

Kod:

For j = 1 To 3
opt(j - 1) = 0 ' zerowanie liczników
Next j

Dlaczego petala tylko do 3?

Jak również tego zapisu:

Kod:

Case "SEAL"
Cells(j, 13 + opt(1)) = Cells(i, 4)
opt(1) = opt(1) + 2
Case "TERM"
Cells(j, 12 + opt(2)) = Cells(i, 4)
opt(2) = opt(2) + 2

Sorki za dalsza pomoc i pewnie głupie pytania

Pozdr....

Aquaman · Fan Excela **Pomógł:** 29 razy Posty: 69

Może tak... Po pierwszym znalezionym ".1" można byłoby wyznaczyć kolejne połozenie ".1", a w zakresie pomiędzy nimi spróbować posprawdzać warunki by, byc może, w ten sposób zminimalizować liczbę kroków. Poszedłem jednak po minimum oporu i przelatuję krok po kroku cały zakres tj. tyle ile jest rekordów.
Pętla While ma za zadanie przelecieć wszystkie rekordy. To mogłaby być równie dobrze pętla Until lub For - chociaż tej ostatniej nie stosuję, jeśli w pętli mam zamiar z jakiegoś powodu zwiększyć krok. (: A właśnie pętla Until niejako to robi. Ma za zadanie wyszukać kolejne ".1" i przy okazji posprawdzać warunki (jeśli nie występuje ".1"). Nie wykona się po znalezieniu kolejnego ".1" (ale tym zajmnie się ponownie pętla While). Czy zastosujesz tą, czy tą - nie ma znaczenia dopóki robi to czego oczekujesz, i poprawnie zapiszesz warunki jej wykonania. Innymi słowy jeśli wystąpiło ".1" to zakładam, że następne wiersze trzeba przeanalizować do kolejnego wystapienia ".1" - tutaj kłania się Until - a robię to, jeśli w wierszu występuje "..2". Analizę zwalam na instrukcję Select Case, chociaż równie dobrze mogłoby to być instrukcja If Then.

W poniższej deklaracji tablicy umieściłem mały komentarz:

Kod:

Dim opt(3) As Long ' indeks: 0 dla "CABL", 1 dla "SEAL", 2 dla "TERM"

Wyszło 3 bo tyle założyłem. Liczniki wykorzystuję do przesunięcia wpisu o dwie kolumny... Np. po znalezieniu "TERM" dokonuję wpisu w kolumnie 12 z przesunięciem 0 (bo tyle wynosi początkowo licznik) i zwiększam licznik o 2 - co widać w instrukcji Select Case. W efekcie przy znalezieniu kolejnego "TERM" (także w instrukcji Select Case) dokonuję wpisu w kolumnie 12 z przesunięciem 2, czyli 14 (i znowu licznik zwiększam o dwa - czy wykorzystam czy nie, nieistotne).
Dlatego też liczniki trzeba sobie w odpowiednim momencie wyzerować, bo gdyby tego nie zrobić to następne wpisy "TERM" przeskakiwałyby o kolejne 2 kolumny... A takim momentem, w którym trzeba je wyzerować jest znalezienie ".1" jeśli znajdziesz też w tym wierszu "DR". Jeśli znajdę ".1", ale nie ma "DR" to nic się nie dzieje, bo Twoja instrukcja nic o tym nie mówi.

W pętli For zerownaia liczników używam zmiennej j, bo aktualna jej wartość nie jest mi już potrzebna. Linijkę niżej i tak zapamiętam w niej numer wiersza wpisywanych danych...

BTW
Warunek 2 (zwłaszcza koncówka) jest dla mnie niezrozumiały, w efekcie nie wiadomo co i gdzie wpisywać.

Cytat:

1.wpisz w zakładce 'Wynik" kolumna A jeżeli w kolumnie F kod rozpoczyna się od DR oraz w kolumnie A wystepuje .1
2. jeżeli warunek 1 jest prawda wpisz w kolumnie B i C dane z kolumn D i F oraz w kolumnie A wystepuje .2
3. jeżeli w kolumnie E wystepuje "Term" oraz w kolumnie A wystepuje .2 to wpisz w kolumnie T1
4. jeżeli w kolumnie E wystepuje "Seal" oraz w kolumnie A wystepuje .2 to wpisz w kolumnie S1
5. jeżeli w kolumnie E wystepuje "Term" drugi raz oraz w kolumnie A wystepuje .2 to wpisz w kolumnie T2
6. jeżeli w kolumnie E wystepuje "Seal" drugi raz oraz w kolumnie A wystepuje .2 to wpisz w kolumnie S2

Jeśli w kolumnach [B], [C] (excelowskie "J", "K") ma być wpiswany wiersz, w którym występuje "CABL" to możesz to dopisać w instrukcji Select Case, analogicznie jak "TERM", i "SEAL". Cchyba, że ma to być cokolwiek z pierwszego wiersza po ".1" jeśli występuje w nim "..2"?
Dla "CABL" licznika nie musisz tam zwiększać (z rozpędu zarezerwowałem na to licznik). Wtedy pomijasz występujące po pierwszej instrukcji If

Kod:

Cells(i, 10) = Cells(i, 4)
Cells(i, 11) = Cells(i, 6)

Patrz poniższy kod.

Kod:

Option Explicit
Sub test()
Dim i As Long, j As Long, s As Long, t As Long, ostA As Long
Dim opt(3) As Long
'Dim tmp As String ' = ..., "CABL", "SEAL", "TERM", ...

i = 1
ostA = Cells(Rows.Count, "A").End(xlUp).Row
Do While i < ostA
i = i + 1
'Cells(i, 1).Select
If Cells(i, 1) = ".1" And UCase(Left(Cells(i, 5), 2)) = "DR" Then
Cells(i, 9) = Cells(i, 5)
For j = 1 To 3
opt(j - 1) = 0
Next j
j = i ' zapamiętujemy wiersz wpisywanych danych
Do Until Cells(i + 1, 1) = ".1" Or i > ostA
i = i + 1
If Cells(i, 1) = "..2" Then
'InStrRev(UCase(Cells(i, 5)), tmp)
Select Case UCase(Left(Cells(i, 5), 4))
Case "CABL"
Cells(j, 10) = Cells(i, 4)
Cells(j, 11) = Cells(i, 6)
Case "SEAL"
Cells(j, 13 + opt(1)) = Cells(i, 4)
opt(1) = opt(1) + 2
Case "TERM"
Cells(j, 12 + opt(2)) = Cells(i, 4)
opt(2) = opt(2) + 2
Case Else
' niestandardowe przypadki, ale nic nie robimy...
End Select
End If
'Cells(i, 1).Select
Loop
End If
Loop
End Sub

Instrukcję Select Case możesz sobie zrobudować, ale musisz pamiętać, że ona odcina 4 początkowe znaki (zamienia na duże litery) i porównuje je ze swoimi "warunkami".

Reasumując. Latam sobie w pętli While by przejść cały zakres rekordów. Jeśli natrafię na kombinację ".1" z "DR" to kolejne wiersze analizuję pętlą Until aż do kolejnego ".1", a warunki sprawdzam instrukcją Select Case. Jeśli w pętli Until natrafię na ".1" to ta pętla się nie wykona, ale sterowanie wróci do pętli While, dzięki czemu mogę ponownie sprawdzić warunek dla ".1" z "DR"... itd.
Nie wiem czy takie wyjaśnienia Ci wystarczą? (:

mar1980 · Fan Excela Posty: 99

Dzieki Aquaman za wyjasnienia.

Pozdrawiam i dziekuje

Aquaman · Fan Excela **Pomógł:** 29 razy Posty: 69

Tak jeszcze sprostuję, że poniższa deklaracja rezerwuje 4 indeksy (od 0 do 3). Pomerdało mi się z C.

Kod:

Dim opt(3) As Long

W instrukcji Select Case możesz przetwarzać kilka przypadków "na raz" (o ile nie ma przeciwskazań), przykładowo:

Kod:

Case "MATE", "ASM "
' instrukcje

(w twoim przykładzie byle czteroliterowe, bo tyle w przykładzie było odcinanych do porównania).
Możesz też dodać w sekcji Case Else (odpowiada za pozostałe niestandardowe przypadki) sprawdzenie np. i = j + 1 co pozwoli Ci na wpisanie wartości z pierwszego wiersza po ".1". Oczywiście ma to sens, o ile warunki sprawdzające (Case) się nie duplikują.

Powodzenia. :)