Cześć, stworzyłem pętlę która dodaje pustą kolumnę z nagłówkiem w wybrane miejsce przez InputBox.
For i =1 To 1
ws1.Columns(iCol).EntireColumn.Insert
ws1.Cells(1, iCol).Value = "Level " & iCol
Next i
Niestety nie wiem jak zrobić żeby dodawać kolumnę z danymi które są w ostatniej kolumnie. Zależy mi na tym żeby przeszukać czy coś znajduje się we wcześniejszej kolumnie i jeśli tak to przenieść to do nowej kolumny w konkretne miejsce za pomocą tej pętli.
Dodałem kopiowanie ale jak wklejać wartości o jeden poziom niżej niż w poprzedniej kolumnie?
np. tak:
Sub Test()
''coś przypisałem żeby działało
Dim ws1 As Worksheet
Dim iCol As Integer
Dim pierwsza_obok As Range
Set ws1 = Sheets(1)
iCol = 2
'tu zaczyna się właściwa część
Set kolumna_obok_drugi_wiersz = ws1.Cells(2, iCol - 1)
'''ws1.Range(kolumna_obok_drugi_wiersz, kolumna_obok_drugi_wiersz.End(xlDown)).Copy ws1.Cells(2, iCol) '''poprawione niżej
ws1.Range(kolumna_obok_drugi_wiersz, kolumna_obok_drugi_wiersz.End(xlDown)).Copy ws1.Cells(3, iCol)
End Sub
Dim addColumn As Range
iCol = 2
Set addColumn = ws1.Cells(2, iCol - 1)
ws1.Range(addColumn, addColumn,End(xlDown)).Copy ws1.Cells(2, iCol)
ws1.Cells(1, iCol).Value = "Level " & iCol
Czy coś pomyliłem w tym kodzie? Zwiesza mi się excel :D
Działa ale nie powiedziałem o jednej rzeczy. Musi to być insert kolumny bo tę którą dodaje nie jest ostatnia, dalej są inne kolumny. Czyli najprościej mówiąc dodaje jedną kolumnę między inne kolumny. Ten kod w przypadku ostatniej wartości z kolumny którą kopiuje nie wkleja tej wartości do nowej kolumny. Nie wspomniałem że te kolumny tworzą tabelę i chodzi też o to żeby powiększać ją o ten jeden wiersz jeśli w poprzedniej kolumnie jest jakaś wartość.
Próbowałem czegoś takiego ale ze względu na Cellls(3, iCol) wyskakuje mi komunikat "You can't paste this here because the Copy area and paste area aren't the same size"
ws1.Columns(iCol - 1).EntireColumn.Copy ws1.Cells(3, iCol)
Z ws1.Columns(iCol) normalnie działa ale nie obniża wartości o jeden wiersz.
Nie zmienia to faktu że przy wklejaniu usuwam kolejne kolumny więc to chyba nie jest dobry sposób.
Demirion napisał(a):
Próbowałem czegoś takiego ale ze względu na Cellls(3, iCol) wyskakuje mi komunikat "You can't paste this here because the Copy area and paste area aren't the same size"
ws1.Columns(iCol - 1).EntireColumn.Copy ws1.Cells(3, iCol)
Nic dziwnego, że masz taki błąd - przeklejasz całą kolumnę do komórek od 3 wiersza == brakuje Ci 2 wierszy w docelowej kolumnie :)
Sub Test()
iCol = 4
Columns(iCol).EntireColumn.Copy
Columns(iCol).Insert
Dim addColumn As Range
Set addColumn = Cells(2, iCol + 1)
Range(addColumn, addColumn.End(xlDown)).Copy Cells(3, iCol + 1)
Cells(1, iCol + 1) = "nowy nagłówek"
Cells(2, iCol + 1) = "puste"
End Sub
Zrobione na szybko. Powinno działać.
Mocno awaryjny jest ten kod i nie do końca o to mi chodziło. Nie wiem też po co te +1 skoro mam skopiować zakres z ostatniej kolumny. Być może niezbyt dokładnie wyjaśniłem o co mi chodzi. Makro powinno dodawać kolumnę i brać dane z wcześniejszej kolumny i dodawać je o poziom niżej w tej nowej kolumnie. Te dane to zazwyczaj pojedyncze komórki (np tytuły) więc funkcja End(xlDown) się nie sprawdza. Obecnie to gdzie wstawię nową kolumnę wybieram przez InputBox który jest pod zmienną iCol. Kombinowałem z tym kodem i wydaje mi się że najbliżej tego o co mi chodzi jest ten kod:
ws1.Columns(iCol).EntireColumn.Insert
ws1.Cells(1, iCol).Value = "Level " & iCol
ws1.Cells(2, iCol - 1).Copy Cells(3, iCol)
Nie wiem tylko jak to sprawnie zrobić żeby nie kopiowało tylko drugiego wiersza ale od 2 wiersza do samego końca tabeli "wsWBS.Cells(2, iCol - 1).Copy Cells(3, iCol)".
Docelowo ma nie być InputBoxa tylko powinno dodawać nową kolumnę za ostatnią z wprowadzonymi danymi i to nie na koniec tabeli tylko wewnątrz bo w dwóch ostatnich kolumnach są inne dane i nie chcę ich ruszać. Trochę zagmatwane :D
Udało mi się znaleźć rozwiązanie:
ws1.Range(ws1.Cells(2, iCol - 1), ws1.Cells(Rows.Count, iCol - 1).End(xlUp)).Copy Cells(3, iCol)
Dzięki za pomoc. Temat do zamknięcia.