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

Excel VBA kopiowanie co drug± linię

AJOT74 02 Sty 2011 23:32 1855 6
  • #1 02 Sty 2011 23:32
    AJOT74
    Poziom 10  

    Mam taki sobie kod:

    Select Case Target
    Case "A": Sheets("Arkusz2").Range(Target.Address).Offset(4, 1) = "8"
    Case "B": Sheets("Arkusz2").Range(Target.Address).Offset(4, 1) = "16"
    End Select

    Funkcja kopiuje, zmienia i przenosi dane do innego arkusza.
    Mnie chodzi o to aby dane trafiały do innego arkusza co drug± linię tzn.:


    Arkusz1 A1 > Arkusz2 A4
    Arkusz1 A2 > Arkusz2 A6
    Arkusz1 A3 > Arkusz2 A8

    itd...

    0 6
  • #2 03 Sty 2011 10:30
    walek33
    Poziom 28  

    Cytat:
    Mam taki sobie kod...

    A gdzie reszta? Bo ten kawałek (tak mi się wydaje, a mogę się nie znać) nic nie kopiuje ani nie przenosi.

    0
  • #3 03 Sty 2011 16:55
    AJOT74
    Poziom 10  

    Private Sub Worksheet_Change(ByVal Target As Range)

    Select Case Target
    Case "A": Sheets("Arkusz2").Range(Target.Address).Offset(3, 3) = "8"
    Case "B": Sheets("Arkusz2").Range(Target.Address).Offset(3, 3) = "16"
    End Select

    End Sub



    Zapraszam to do wrzucenia dla Arkusz1 w VBA i wpisania dużych znaków A lub B w EXCEL, po przej¶ciu do Arkusz2 widać efekt.

    0
  • #4 04 Sty 2011 08:50
    walek33
    Poziom 28  

    Bez montowania tej procedurki potrafię powiedzieć, że ona nic nie przenosi ani nie kopiuje. I przy tym trwał będę uparcie. Moim skromnym zdaniem wstawia ona stał± warto¶ć (8 lub 16) do komórek arkusza 2 przesuniętych o offset 3,3 w stosunku do komórki modyfikowanej w arkuszu 1. Gdzie tu jest kopiowanie?
    Je¶li się mylę popraw mnie.

    A je¶li chodzi o trafianie w co drugi wiersz to spróbuj tej modyfikacji:

    Code:
    Case "A": Sheets("Arkusz2").Range(Target.Address).Offset(2 + Target.Row, 3) = "8"
    
    Case "B": Sheets("Arkusz2").Range(Target.Address).Offset(2 + Target.Row, 3) = "16"

    Powinna działać, ale nie sprawdzałem. :cry:

    0
  • #5 07 Sty 2011 10:43
    AJOT74
    Poziom 10  

    OK. Złe okre¶lenie z tym kopiowanie i przenoszeniem, chodziło mi bardziej o to, że na podstawie jakich¶ tam znaków zmienia na jakie¶ tam znaki i pod odpowiednim przesunięciu zapisuje jakie¶ znaki.
    Wszystko działa mi pięknie, ale mam problem gdyż:

    Sub procedurka()
    Select Case Target
    Case "A": Sheets("Arkusz2").Range(Target.Address).Offset(2 + Target.Row, 3) = "8"
    Case "B": Sheets("Arkusz2").Range(Target.Address).Offset(2 + Target.Row, 3) = "16"
    End Select
    End Sub

    Private Sub Worksheet_Change(ByVal Target As Range)

    Select Case Target
    Case "A": Sheets("Arkusz3").Range(Target.Address).Offset(2 + Target.Row, 3) = "8"
    Case "B": Sheets("Arkusz3").Range(Target.Address).Offset(2 + Target.Row, 3) = "16"
    End Select
    call procedurka
    End Sub

    Niestety okazuje się, że to co jest w PROCEDURKA po prostu nie działa...

    0
  • #6 07 Sty 2011 23:29
    walek33
    Poziom 28  

    I nie zadziała. Zabrakło drobnego szczegółu.

    Code:
    Sub procedurka(Target)
    
    ...
    ...
    call procedurka(Target)
    ...

    Po zmianach powinno hulać. W pierwszym wierszu możesz jeszcze zadeklarować czym ów Target ma być.
    Popatrz na wzór deklaracji:
    Code:
    Private Sub Worksheet_Change(ByVal Target As Range)

    0
  • #7 08 Sty 2011 13:20
    AJOT74
    Poziom 10  

    :D:D:D:D:D:D
    Dzięki...

    0