zapomniales Dir() przed Loop tj. plik=Dir()
Przed linijką: Do While art < zm + 1 dopisz linijkę: art = 2
Rozwiązań jest naprawdę sporo Zgadzam się z tym poglądem i choć autor postu chyba zasypał się w tych rejestrowanych makrach :-) to podsuwam nieco inne rozwiązanie tego zadania marek003 obawiam się uruchomienia takiego masowego wydruku na nieokreślonej drukarce (jednostronna czy dwustronna) i dlatego proponuję rozwiązanie z exportem wszystkich podzleceń...
[syntax=vb]wiersz = 6 Sheets(1).Activate While Cells(wiersz, 1) <> "" Cells(wiersz, 2).Copy Sheets(Cells(wiersz, 1).Text).Range("C8") wiersz = wiersz + 1 Wend [/syntax]
Czy istnieje możliwość definicji zmiennej pętli do while na wybrane przez siebie liczby? Potrafię zdefiniować zmienną w ten sposób, by zwiększała się ona tak jak na przykładzie o wartość dowolnej liczby: wiersz=1 Do While Range("A" & wiersz) <> "" wiersz = wiersz + 1 Loop Chciałbym zamiast przeglądania każdego rekordu z przedziału ("wiersz+1",...
[syntax=vbscript]Sub ImportujPliki() Application.ScreenUpdating = False Set b = ThisWorkbook Sciezka = "C:\PlikiExcela\" Plik = Dir(Sciezka & "*.xls*") x = 1 While Plik <> "" Set a = Workbooks.Open(Sciezka & Plik) Sheets(1).Copy After:=Workbooks("ImportujPliki.xlsm").S... a.Close False Plik = Dir x = x + 1 Wend Application.ScreenUpdating...
Co setny zostaje. [syntax=vbscript]Sub co_sto() i = 1 Do While Cells(i, 1) <> "" Rows(i).Resize(99).Delete i = i + 1 Loop End Sub[/syntax]
[syntax=vbscript]Sub Sumuj() Application.ScreenUpdating = False Katalog = "C:PlikiExcela" Plik = Dir(Katalog & "*.xls*") While Plik <> "" Set a = Workbooks.Open(Katalog & Plik) For x = 1 To Sheets.Count Sheets(x).Range("OO1").Formula = "=SUM(A1:A100)" s = s + Sheets(x).Range("OO1") Sheets(x).Range("OO1") = "" Next a.Close False Plik =...
Zobacz tak [syntax=vb]plik = Dir(sciezka & "\Dokumenty" & "\*.*") Do While plik <> "" ListaDokumenty.AddItem plik plik = Dir Loop[/syntax]
Zobacz tak: [syntax=vbscript]Sub Kopiuj_MG() Dim x As Long, n As Long Application.ScreenUpdating = False Sheets("Arkusz1").Select x = 2 Do While Range("A" & x).Value <> vbNullString If Cells(x, "C") > 1 Then Range("A" & x & ":C" & x).Copy n = Range("C" & x).Value Range("A" & x & ":C" & x + n - 2).Insert xlShiftDown...
Ale dlaczego pętla for? Bardziej naturalna to będzie np. taka pętla: [syntax=vbnet] Dim Y As Long Y = 1 Do While Cells(Y, 1) <> "" If Cells(Y, "B") = "" Then Cells(Y, "B") = "XXX" Y = Y + 1 Loop [/syntax]
Odpal takie makro [syntax=vb]Sub koko() r = 2 While Cells(r, 1) <> "" If Cells(r, 1) = Cells(r + 1, 1) Then Cells(r, 2) = Cells(r, 2) & vbLf & Cells(r + 1, 2) Rows(r + 1).Delete r = r - 1 End If r = r + 1 Wend End Sub [/syntax]
Trochę lekkich poprawek kodu, i rozłożenie na 2 pętle spowodowało że kod działa prawidłowo. W jednej pętli drukowało 1 plik i koniec, nie miałem pomysłu i czasu na dłuższą zabawę z tym kodem dlatego wrzucam w takiej formie w jakiej mi się udało (przetestowane, działa) [syntax=vbscript] Sub drukuj_z_raportem() Dim PPath$, buf$ Dim r As Integer Cells(1,...
[syntax=vbscript]Sub Konwersja() With Application.FileDialog(msoFileDialogFold... .Title = "Wybierz folder z plikami CSV" .InitialFileName = Environ("userprofile") & "\Desktop" If .Show = -1 Then f = .SelectedItems(1) End With If f = "" Then Exit Sub x = "\PlikiExcel" If Dir(f & x, vbDirectory) = "" Then MkDir (f & x) csv = f &...
Dodano po 19 Excel / VBA / wstawianie i kopiowanie wierszy z rozdzieleniem wartości
[syntax=vb]Sub Importuj() Dim Plik As String Plik = Dir("C:\DoImportu\*.txt") Do While Plik <> "" 'Tutaj to, co już umiesz, czyli import pliku (zmienna Plik) Plik = Dir Loop End Sub [/syntax]
Wg podanych informacji, najprościej którąś z Do. Coś w tym rodzaju: [syntax=vb]wrs = 2 Do While Cells(wrs, 6) <> "" Cells(wrs, 4) = "ble ble ble" wrs = wrs + 1 Loop[/syntax]
[syntax=vbscript]Sub test() x = 1 With Sheets("lista") Do While .Cells(x, 1) <> "" Sheets("000").Copy After:=Sheets(Sheets.Count) ActiveSheet.Name = Format(x, "000") Cells(12, 34) = .Cells(x, 1) x = x + 1 Loop End With End Sub[/syntax]
[syntax=vb]Sub doBazy() r = 1 With Sheets("raport") While .Cells(r, 1) <> "" rb = Application.Match(.Cells(r, 1), Sheets("baza").Columns(1), 0) .Cells(r, 2).Resize(, 5).Copy Sheets("baza").Cells(rb, 2) r = r + 1 Wend End With End Sub [/syntax]
[syntax=vb]Do While .Cells(i, 1) <> "" If .Cells(i, 1) < #5/1/2016# Then .Rows(i).Delete ' data w formacie "amerykańskim" i = i - 1 End If i = i + 1 Loop[/syntax]
1. ^ to operator logiczny alternatywy rozłącznej. Co on tu robi? Raczej chodziło Ci o potęgowanie. Nie ma operatora potęgowania - trzeba użyć funkcji. Operator potęgowania w postaci ^ to, jeśli dobrze pamiętam, tylko Basic wykorzystywał (i Excel ;) ) 2. Rozmiar tablic dynamicznych podaje się w nawiasach kwadratowych. Nie wiem, co oznacza zapis stworzony...
Mały przykład [syntax=vb]Sub Petla() Dim licznik As Integer, ile As Integer ile = 500 'ile = Range("E1") Do While licznik < ile licznik = licznik + 1 test = Cells(licznik, 1) Loop MsgBox licznik End Sub[/syntax]
Może jakoś tak: [syntax=vbnet] sub Test() dim Fn as string, Wb as object Fn=Dir("C:\twój katalog\*.xlsx") do while (Fn <> "") set Wb=Open(Fn) Sheets(2).Select Fn=Dir loop end sub [/syntax] Tylko otwiera plik i wchodzi do 2 zakładki, nic więcej nie robi.
[syntax=vb] Open "C:\Plik.csv" For Input As #1 While Not EOF(1) Line Input #1, Linia a = Split(Linia, ";") Cells(x, 1) = a(1) x = x +1 Wend [/syntax] Idź tym tropem.
[syntax=vbscript]Sub OdczytajWpistest() Open "C:\wpisy.txt" For Input As #1 maxVal = 0 Do While Not EOF(1) Input #1, Kiedy If Kiedy > maxVal Then maxVal = Kiedy Loop Range("AD1") = maxVal + 1 Close #1 End Sub[/syntax]
Ok. Zrozumiałem. napisałem małe makro dla zakresu i pętlą sprawdzanie. plik w zalączeniu. kod: Option Explicit Sub ZakresPetla1() Dim wiersz As Long For wiersz = 19 To 30 Step 1 Do While Cells(wiersz, 2).Value = Range("E16").Value Range("F16").Copy Cells(wiersz, 3).PasteSpecial wiersz = wiersz + 1 Loop Next End Sub
makrem[syntax=vb]Sub usunDupKol() tRow = 3 While Cells(tRow, 1) <> "" For c = Cells(tRow, Columns.Count).End(xlToLeft).Column To 2 Step -1 If Application.CountIf(Rows(tRow), Cells(tRow, c)) > 1 Then Cells(tRow, c).Delete xlToLeft End If Next tRow = tRow + 1 Wend End Sub [/syntax]
Witaj Makrem [syntax=vb] Sub abcde() r = 1 While Cells(r, 1) <> Empty For i = 1 To 5 Cells(r + i, 1) = Cells(r, 1) & Chr(64 + i) Next r = r + 6 Wend End Sub [/syntax]
bez komorek [syntax=vb] Sub Workbook_BeforeClose(Cancel As Boolean) FolderName = ActiveWorkbook.Path & "\ARCHIWUM\" If Dir(FolderName, vbDirectory) = "" Then MkDir FolderName f = Dir(FolderName & "Rejestr_napraw_form_*") While f <> "" fdt = FileDateTime(f) If fdt > dtm Then dtm = fdt f = Dir Wend If Now() - dtm < 7 Then Exit Sub...
Hmm, może dwie pętle? Jedna do określenia Nr wiersza, druga do wypełniania... [syntax=vb]wrs = 1 strS = "MAGMA" maks = 1000 'ustawienie maksimum, coby nie wpaść w nieskończoną Do While Cells(wrs, 6) <> strS If wrs = maks Then Exit Sub wrs = wrs + 1 Loop Do While Cells(wrs, 7) <> "SUMA" If wrs = maks Then Exit Sub wrs = wrs + 1 Cells(wrs,...
Jeżeli chodzi o sumowanie cyfr w liczbie to zostaje tylko makro, moge troszkę podpowiedzieć: Sub main() Dim c, x As Integer x = InputBox("") While x <> 0 c = c + x Mod 10 x = x \ 10 Wend MsgBox(c) End Sub
Zmodyfikuj ten kod np tak :spoko: : [syntax=vbscript]Sub filtr() a = Range("C3") b = Range("C4") i = 7 c = 0 Do While Cells(i, 3) <> "" If (Cells(i, 3) >= a) And (Cells(i, 3) <= b) Then Rows(i).EntireRow.Hidden = False c = c + 1 Else Rows(i).EntireRow.Hidden = True End If i = i + 1 Loop [A1] = c End Sub[/syntax]
Może przez szukanie w pętli z wykorzystaniem obsługi błędu. Np[syntax=vb]On Error Resume Next Do While Err = 0 kol = Rows(1).Find(what:="MSISDN", lookat:=xlWhole).Column kol = Rows(1).Find(what:="Kod Sprzedawcy", lookat:=xlWhole).Column Columns(kol).Delete Loop[/syntax]
[syntax=vb]Sub Powiel() x = 1 Z = 1 While Cells(x, 10) <> "" For y = 1 To Cells(x, 11) Cells(Z, 13) = Cells(x, 10) Z = Z + 1 Next y x = x + 1 Wend End Sub [/syntax]
Na początku pętli [syntax=vbscript]Do While Len(ws_src.Range("E" & i)) > 0[/syntax]jest sprawdzany warunek czy długość zapisu w kolumnie E jest > 0. Eliminuje to przypadki pustych komórek i pustych tekstów. Gdybyś jeszcze chciał sprawdzać wartości zerowe to trzeba dodać nowy warunek pod spodem: [syntax=vbscript]If ws_src.Range("E" & i) = 0 Then Exit...
Trochę dziwi mnie Twój pomysł, ale proszę: [syntax=vb]Sub DodajKod() Dim Linia As Long, Kod As String Open "C:\PlikVBA.txt" For Input As #1 With ActiveWorkbook.VBProject.VBComponents("T... While Not EOF(1) Linia = Linia + 1 Input #1, Kod .InsertLines Linia, Kod Wend End With Close #1 End Sub [/syntax]
Witaj [syntax=vb] Sub bombon() Dim zakr10 As Range Set zakr10 = ThisWorkbook.Sheets("Bombonierki").Range... r = 2 While Cells(r, 1) <> vbNullString If Application.Count(zakr10.Rows(r)) > 0 Then Cells(r, 1).Interior.ColorIndex = 6 End If r = r + 1 Wend End Sub [/syntax]
A gdyby tak "zwykłym" Dir'em? [syntax=vbscript]Dim oFSO As Object, oFolder As Object, oSubFolder As Object, oSubSubFolder As Object, test As String Set oFSO = CreateObject("Scripting.FileSystemObject... Set oFolder = oFSO.GetFolder("c:\Pliki\") For Each oSubFolder In oFolder.subfolders For Each oSubSubFolder In oSubFolder.subfolders plik = Dir(oSubSubFolder.Path...
aaa.. Formuła nie może działać w tej samej komórce Można podzielić 1 kolumne na inne dwie - przed 'w' i po 'w' zmienić jednu kolumnu tylko makrem [syntax=vb]Sub kokos() Dim c As Range Set c = Cells(1, 1) While c <> "" p = Application.WorksheetFunction.Search("w"... c) c.Offset(, 1) = Mid(c, p) c = Left(c, p - 1) Set c = c.Offset(1) Wend End Sub...
Można spróbować przy pomocy funkcji wbudowanych, ale trochę tego dużo. Próbka na 60 wierszach. W B2 wpisujesz =A2 a dalej kopiowana formuła, jak na obrazku: http://obrazki.elektroda.pl/3680479800_1... W kolumnie C osiągniemy to samo wspomagając się takim[syntax=vb]Sub Co10() wrsSrc = 2 wrsDst = 2 Cells(wrsDst, 3) = Cells(wrsSrc, 1) Do...
[syntax=vbscript]Sub Dzialaj() Application.ScreenUpdating = False Dim Tekst As String Sciezka = "C:\PlikiExcela\" Tekst = "mój tekst" Plik = Dir(Sciezka & "\*.xls*") While Plik <> "" Call Wyszukaj(Sciezka & Plik, Tekst) Plik = Dir() Wend Set fso = CreateObject("Scripting.FileSystemObject... Set s = fso.GetFolder(Sciezka) For Each p In s.SubFolders...
Prostym makrem można tak (wklej w kod arkusza i uruchom; zapisze w kol.A) [syntax=vbscript]Sub numerowanie() Dim w As Integer, test As String Dim licznik1 As Integer, licznik2 As Integer, licznik3 As Integer w = 3 Do While Cells(w, 5) <> "" If Cells(w, 4) = "__Element" Then licznik1 = licznik1 + 1 licznik2 = 0 licznik3 = 0 ElseIf Cells(w, 4) =...
[syntax=vb] Sub DelDupl() With Sheets(1).Range("A:B") r = 2 While .Cells(r, 1) <> Empty If Application.CountIf(.Columns(1), .Cells(r, 1)) > 1 Then .Rows(r).Delete shift:=xlUp r = r - 1 End If r = r + 1 Wend End With End Sub [/syntax] jeszcze nie jest dobre?
Argument jest typu String, więc podstaw sobie [syntax=vbscript]R = 3 While Cells(R, 2) <> "" karta = Cells(R, 2) ostW = Sheets(karta).Cells(1501, 11).End(xlUp).Row Cells(R, 3).FormulaR1C1 = "=countcellsbycolor('" & karta & "'!R1C11:R" & ostW & "C11,MENU!RC[-1])" R = R + 1 Wend[/syntax]
Myślę, że najlepsze wyniki czy nie od końca, ale od początku [syntax=vb]Sub Wstawianie_wierszy() Dim i As Long, r As Long, c As Long Application.ScreenUpdating = False i = 2 r = i While Cells(i, 11) <> Empty If Cells(i, 11) <> Cells(i + 1, 11) Then Rows(i + 1).Insert For c = 5 To 7 Cells(i + 1, c + 3) = Application.WorksheetFunction.Sum(Range(...
Tu masz proste makro: (sprawdza kolumny dopóki jest wartość w kolumnie C zaczynając od 7 wiersza Sub filtr() a = Range("C3") b = Range("C4") i = 7 Do While Cells(i, 3) <> "" If (Cells(i, 3) >= a) And (Cells(i, 3) <= b) Then Rows(i).EntireRow.Hidden...
Skoro tak, to może o to Ci chodzi? [syntax=vbscript]Sub Rozdziel() k = 1 While Cells(2, k) <> "" If InStr(1, Cells(2, k), "-") > 0 Then Cells(2, k + 1).EntireColumn.Insert ow = Cells(Rows.Count, k).End(xlUp).Row Range(Cells(2, k), Cells(ow, k)).TextToColumns _ Destination:=Range(Cells(2, k), Cells(ow, k)), DataType:=xlDelimited, _ TextQualifier:=xlDoubleQuote,...
Można też tak. Całkiem szybko działa. Dodano po 3 jeśli czytamy większe arkusze danych (u mnie 2 sek Musisz zrobić próbę...
Myślę, że zwykłe czytanie (xml potraktowane jako pliki sekwencyjne) powinno poradzić. Wklej do modułu standardowego i wypróbuj [syntax=vbscript]Option Compare Text Option Explicit Sub Proba() Dim katalog As String, plik As String, linia As String Dim licznik As Long, ko As Integer, startuj As Boolean katalog = "c:\" 'podstaw katalog z xml'ami. Slash...
Witam Pliki musisz pakować rar/zip itp. Co do ładowania danych do comboboxa odpowiedzialna jest część j.n musisz dopisać z jakiej zakładki są pobierane dane czyli [syntax=vbnet]Private Sub UserForm_Initialize() Dim i As Long i = 2 'bez nagłówka 'zapisanie do tablicy Do While Sheets("Articles").Cells(i, 1) <> "" AddItem Sheets("Articles").Cells(i,...
excel makro while arduino while instrukcja while
nagrywanie plików atmega zewnętrzny kwarc przyczepa kempingowy
kalibracja hydrostatu tomek janiszewski
Odblokowanie telefonu przez połączenie alarmowe: ryzyka i alternatywy 4872-99 zamiennik – 2N4872 UJT, 2SC4872, 2SA1872, KSC2383, KSA1013, PUT 2N6027