For i = 0 To UBound(PATH) Folder = Folder & PATH(i) & "\" If PATH(i) = "" Then CheckDir = Dir(FullPath & "Nowy" & Date, vbDirectory) If CheckDir <> "" Then MsgBox CheckDir & " - taki folder już istnieje" Else MkDir FullPath & "Nowy" & Date MsgBox "Utworzono nowy folder " & FullPath & "Nowy" & Date End If...
Dla kodu [syntax=vbscript]Sub Makro1() Dim Fn As String, Wb As Object Fn = Dir("D:\abc\*.xlsx") Do While (Fn <> "") set Wb=Open(Fn) Sheets(2).Select Fn = Dir Range("A1").Select ActiveCell.FormulaR1C1 = "test" Loop End Sub[/syntax] w linijce [syntax=vbscript]set Wb = Open(Fn)[/syntax] wyskakuje Compile error: syntax error
[syntax=vbscript] On Error GoTo SubStop For Each Sheet In Worksheets Sheet.Test Next Sheet SubStop: On Error GoTo 0[/syntax]
także wszystko powinno działać No właśnie nie. Co do twojego kodu to jak chcesz to [syntax=vbscript]Sub Makro_K() On Error Resume Next Range("I20:O119").SpecialCells(xlCellTyp... = "=IF(R9C4=R18C,""X"","""")" End Sub[/syntax]
Strzelam :) Czyli przeszukujemy zakres (tu zapisany w tablicy) [syntax=vb]Dim XlApp As Object Dim Tablica() As Variant Dim WymZloz As Long On Error Resume Next Set XlApp = GetObject(, "Excel.Application") Tablica = XlApp.Worksheets(1).Range("C5:C30") For i = 0 To UBound(Tablica) If WymZloz = Tablica(i) Then knyps = True Exit For Next If knyps And WymZloz...
Bardzo proszę o pomoc. Oto moje makro sub makro1() Dim funkcja1 As String funkcja1 = Range("H17").FormulaR1C1 Range("H20").Formula = "=" & funkcja1 end sub Dla potrzeb tego postu uprościłem to zagadnienie do maksimum. W H17 jest tekst, który chciałbym zamienić na funkcję. Oto jakie mam efekty.... 1. jeżeli w h17 wpiszę: 2+2 makro działa ok 2. jeżeli...
https://obrazki.elektroda.pl/3720846900_... Cześć, próbuję potworzyć trochę w makro ale niestety zablokowałem się, nie potrafię tego rozwiązać, jestem turbo świeżakiem jeżeli chodzi o vba. Ktoś wytłumaczy ?
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]
Proponuję takie makro: [syntax=vbscript]Sub Moduł_Kliknięcie() Dim kom As Range, form As String For Each kom In Selection If kom.HasFormula Then form = Application.Replace(kom.Formula, 2, 0, "ABS(") On Error Resume Next kom.Formula = Replace(form, "*", ")*", 1, 1) On Error GoTo 0 End If Next kom End Sub[/syntax]Przed użyciem makra należy zaznaczyć zakres...
1. Najprościej wyłączyć obsługę błędów For Each element in kolekcja . Np [syntax=vb]zakres = Array([a2], [c3], [d5]) For Each kom In zakres If kom = "" Then kom.Value = "-" Next[/syntax]
Sprawa 1 Trochę niejasna. Czy chcesz sformatować w arkuszu komórkę Cells(x, "S") jako walutową, czy chcesz taką sformatowaną wartość dołączyć do wiadomości, czy jedno i drugie? Bo to są rzeczy niezależne. Jeśli sformatować w arkuszu, to kod: [syntax=vbscript]Cells(x, "S").NumberFormat = "#,##0.00 zł"[/syntax]lub ręcznie. Jeśli chcesz sformatować wartość...
Trochę uprościłem kod. [syntax=vbscript]Sub WstawMakro() Dim VBProj As VBIDE.VBProject Dim VBComp As VBIDE.VBComponent Dim CodeMod As VBIDE.CodeModule Dim LineNum As Long Set VBProj = ActiveWorkbook.VBProject Set VBComp = VBProj.VBComponents("Arkusz1") Set CodeMod = VBComp.CodeModule On Error Resume Next Open "C:\kod.txt" For Input As #1 LineNum = CodeMod.CountOfLines...
A jaki sposób mogę "masowo" stworzyć chekboxa dla 1200 pozycji Możesz spróbować tak: zaznaczyć odpowiedni zakres w kolumnie dla checkboxów, a następnie uruchomić makro: [syntax=vbscript]Sub InsertCheckBoxes() Dim Rng As Range Dim WorkRng As Range Dim Ws As Worksheet On Error Resume Next xTitleId = "Excel" Set WorkRng = Application.Selection Set WorkRng...
Staram się... OK, nagrałem sobie makro, usunąłem co niepotrzebne, dodałem co niezbędne i wyszło coś takiego Znalazłem taki kod ale nie wiem jak go pod siebie przerobić Nie mam pojęcia czy zakres dla procedury zdarzeniowej (określony argumentem: "Me.ListObjects("Lista1").Range.Columns(... ma u Ciebie zastosowanie, czy nie. Może bierzemy się za przerabianie...
Są różne sposoby na znajdowanie ostatniego pustego wiersza, mój ulubiony jest taki: widoczną komórkę w kolumnie B wypełnioną tekstem, idąc od ostatniego wiersza w górę. Liczba 1048576 to ostatni wiersz excela 2007, dla kompatybilności z 2003 należało by użyć 65536. Przed wykonaniem sprawdzania poleceniem ShowAllData próbuje się zdjąć kryteria autofiltra...
Bardzo prosto, wystarczy coś takiego: [syntax=vb]Private Sub CommandButton1_Click() On Error GoTo myErr Set wsdane = ThisWorkbook.Worksheets("Dane") Application.ScreenUpdating = False On Error Resume Next With wsdane .ShowAllData .Range("A2:A" & Rows.Count).ClearContents a = .UsedRange.Row End With On Error GoTo myErr Close #1 Open "c:\plik.txt" For...
[syntax=vbnet]Sub Bazy() On Error Resume Next Dim a As Worksheet, b As Worksheet Set a = Sheets("Baza danych A") Set b = Sheets("Baza danych B") a.Select owa = Cells(Rows.Count, "B").End(xlUp).Row owb = b.Cells(Rows.Count, "C").End(xlUp).Row For x = 5 To owa w = "" w = Application.Match(Cells(x, 2), b.Range("C5:C" & owb), 0) + 4 If w > 0 Then Cells(x,...
lesławek - tak się nie da. Sam spróbuj - ale skopiuj liczbę a nie komórkę. W załączeniu proste makro. Uruchomisz skrótem klawiszowym ctrl+m (można to zmienić) Makro odejmuje od komórki z lewej coś co jest w schowku i wprowadza to formułą w zaznaczonej komórce. [syntax=vb]Sub odejmij_schowek() Dim mem As DataObject On Error Resume Next Set mem = New...
Po Next dodać [syntax=vb] .Cells(w,1).value = .Cells(w-1,1).value + 1[/syntax] Powinno działać. Pamiętaj tylko, że gdy w = 1 dostaniesz error, bo spróbujesz się odnieść do Row = 0. Oraz, jeśli ta komórka nad nie będzie liczbą(bądź pusta), a spróbujesz do niej dodać 1. Można temu zapobiec dodając kilka If'ów. Jednakże myślę, że nie jest to takie znów...
nazwy firm w zależności od statusu tylko na dzień dzisiejszy :?: Jeśli ten warunek jest istotny :?: to te nazwy firm będą jedynie w jednym wierszu (dane dla dnia dzisiejszego :D ) np. tak jak na zrzucie i w załączonym pliku :ok: 1088589 1088592 Jeśli koleżanka preferuje rozwiązania oparte o VBA :?: to można tu zastosować kod, który przy otwarciu pliku...
Prawie dobrze ;) Spróbuj: [syntax=vb]Sub Makro2() MyPath = "C:\magazyn\" myname = Dir(MyPath & "*.xls", vbNormal) rang = Array("D1:F10") 'tu dopisz ile trzeba ark = "Arkusz1" On Error Resume Next 'If ofs > -1 And Err = 0 Then With Sheets("Arkusz1") 'nazwa arkusza docelowego w UŻYWANE.xls For Each rn In rang .Range(rn) = Empty Next Do While myname...
Ok przeoczyłem ten set a jest tu 'myCSVFileName = myWB.Path & "\" & "ZAPAS.csv"', więc musi być 'Set myWB' ps. zobacz teraz [syntax=vbscript]Sub ZapasCSV() With Application .ScreenUpdating = False .EnableEvents = False End With Sheets("ZAPAS_CSV").Select Dim myCSVFileName As String Dim myWB As Workbook Dim tempWB As Workbook Dim rngToSave As Range Application.DisplayAlerts...
Albo zrób sobie "odtwarzarkę wzorów", czyli makro, które je przywróci, moduł vba zabezpieczysz hasłem oraz przed podglądem, wstawisz przycisk w arkusz ... i wtedy żaden użytkownik ci nie straszny, będzie mógł kasować wzory do woli, co minutę ... jedno wciśnięcie przycisku i masz odtworzone formułki, a złośliwy użytkownik zgrzyta zębami ... Dodano po...
A czy jest możliwość stworzenia makra, które po kliknięciu przycisku stworzy automatycznie arkusze dla wszystkich osób (i nada nazwy takie jak w pierwszej kolumnie tabeli tj. nazwisko i imię), a jeśli arkusz dla danych osób już istnieje, to je pominie. Można np tak: 968207
Uruchomiłem excela, utworzyłem takie makro i w linijce: For i = to 10 Wyświetla mi błąd: Compile error: Syntax error
Przetestuj następujące makro [syntax=vb]Sub koloruj() Dim lLstRw& Dim iLstCol% Dim rngTmp As Range lLstRw = Cells(Rows.Count, 3).End(xlUp).Row iLstCol = Cells(1, Columns.Count).End(xlToLeft).Column On Error Resume Next For i = 4 To lLstRw Step 4 Set rngTmp = Range(Cells(i, 4), Cells(i, iLstCol)).SpecialCells(xlCellTypeConstan... If Not rngTmp Is Nothing...
Sprawa jest trochę skomplikowana, bo hiperłącza w Excelu nie lubią sortowania, a sortowanie nie przesuwa odpowiednio hiperłączy. Do tego jeszcze funkcja HIPERŁĄCZE nie obsługuje tablic, tylko pojedyncze komórki. Być może jest to do zrobienia z wykorzystaniem funkcji LAMBDA, nie próbowałem, ale obawiam się, że mogłoby to być dość powolne rozwiązanie....
Po zmianach w kodzie makro działa. Których zmianach ... deklaracji zmiennych: Przy 119 tysiącach wierszy i zakresie kolumn A:AI pojawia się komunikat "Run-time error '7': Out of memory" Spróbuj zmienić: [syntax=vba]Dim w As Long, k As Long, id_w As Long[/syntax] na [syntax=vba]Dim w As Double, k As Double, id_w As Double[/syntax] może się "poprawi"...
[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...
Poprawiony kod, zmienne masz opisane, więc pozostaje przypisać do nich odpowiednie wartości (makro nie sprawdza czy arkusze o zadanych nazwach istnieją w skoroszycie): [syntax=vb]Sub kody_RegEXP() Dim sShSrc$ 'nazwa arkusza źródłowego Dim lRowSrc& 'od którego wiersza sprawdzać dane wejściowe Dim sCol$ 'kolumna z danymi wejściowymi Dim sShDest$ 'nazwa...
Co zrobić, aby po po zmianie wartości w kolumnach 5,6,7,8; Data i godzina w kolumnach B i C pozostała niezmieniona. Odpowiadając tak na "sucho" ... trzeba do kodu dodać coś takiego: Wariant I If Target.Column = 5 Or Target.Column = 6 Or Target.Column = 7 Or Target.Column = 8 Then " można skrócić do " If Target.Column >= 5 And Target.Column <=...
[syntax=vbscript]Sub ImportujPlikizWieluLokalizacji() Dim ZakresWejsciowy As String Application.ScreenUpdating = False Set p = Sheets("Parametry") Set i = Sheets("Import") For x = 2 To p.Cells(Rows.Count, "A").End(xlUp).Row If p.Cells(x, 5) = "x" Then Katalog = p.Cells(x, "A") If Right(Katalog, 1) <> "\" Then Katalog = Katalog & "\" On Error...
Witam To jest makro wyszukane w jakiejś książce nie pamiętam. Tworzy nowe skoroszyty dla filtra z tabeli przestawnej. Zmień fragment aby tworzyło nowe arkusze Dodano po 6 Proponuję stronę helion.pl Tam do książek są przykłady na FTP. Skarbnica przykładów ;-)
Przejrzyj dobrze kod. Ostatnią funkcję masz "zaremowaną". [syntax=vb]'Call GetOnlyGoodValues(x1, x2, x3, x4, x5, x6, x7, x8, x9)[/syntax] Wewnątrz GetOnlyGoodValues wykonywane jest przeszukiwanie. Działa to dobrze bo sprawdzałem, ale generowanie czegokolwiek trwa baaaardzo długo. Zapis do komórek Excela mija się z celem o czym już pisałem. Właśnie dodałem...
gdyż mam makro które tworzy mi CSV Napisałem na szybko takie coś: [syntax=vb] ''' <summary> ''' Zapisuje bierzący arkusz do pliku CSV ''' </summary> Sub SaveCSV() Dim R As Range Dim cmax As Integer Dim rmax As Integer Dim srow As String Dim fname As String cmax = Excel.ActiveSheet.UsedRange.Columns.Coun... rmax = Excel.ActiveSheet.UsedRange.Rows.Count.....
Czy można zmodyfikować poniższe makro Pewnie można ... jak się komuś będzie "chciało chcieć" ... : ) ... ale wpierw parę uwag dla przyszłych twoich "modyfikacji": 1. xlOpenXMLWorkbook - podawałbym kody liczbowe (w tym przypadku jest to 51) zamiast nazwy stałych, będzie bezpieczniej jeśli plik będzie otwierany w różnych wersjach excela: Function CopyDataRangeP...
Popełniłeś dwa błędy w jednym wierszu... Do wyboru If IsNumeric((Cells(i, "I").Value)) = True Then If IsNumeric((Cells(i, 9).Value)) = True Then Natomiast wyszukanie ostatniego wiersza z nazwiskiem możesz zrobić w pętli przez porównanie. Np (dla wierszy od D2 w dół) taką Sub petla() For...
Inny wariant, z wykorzystaniem metody Undo: [syntax=vbscript]Private Sub Worksheet_Change(ByVal Target As Range) If Target.Count = 1 Then Exit Sub Application.EnableEvents = False If Target.Text = "" Then If MsgBox("Czy na pewno chcesz skasować dane z zakresu?", vbQuestion + vbYesNo, "Potwierdzenie") = vbNo Then On Error Resume Next Application.Undo...
Można to zrobić na kilka sposobów, w zdarzeniu Change zeszytu 1 lub w zdarzeniu Activate zeszytu 2. Dla pierwszego przypadku użyłbym takiego makra: [syntax=vb]Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$C$5" Then On Error GoTo myErr Set wsform = ThisWorkbook.Worksheets("Zeszyt 2") wsform.Range("C3:M3").Interior.Pattern.....
Na szybko bo lecę spać i nie sprawdzę, może to będzie dobry trop: [syntax=vbnet] Private Sub Workbook_Open() On Error Resume Next Workbooks.Open(Filename:=ThisWorkbook.Pa... & "\TwójPlik.xls", ReadOnly:=True, UpdateLinks:=xlUpdateLinksAlways).Window... = False End Sub Private Sub Workbook_BeforeClose(Cancel As Boolean) On Error Resume Next Workbooks("\TwójPlik.xls").Close...
Przerobilem to makro tak, ze powinno juz dzialac tak jak chce. Kod ponizej [syntax=vb] Dim myPath As String Dim myFile As String Dim myPass As String Dim mySfrom As String Dim mySto As String Dim oExcel As Excel.Application Dim k As Integer Dim row As Integer On Error GoTo qInst Set oExcel = CreateObject("Excel.Application") row = Cells.SpecialCells(xlCellTypeLastCell).r...
Teraz tracę orientację. Jeśli 'With Workbooks(fld).Sheets(1)' to .showalldata. Jeśli 'With Workbooks(fld)' to .sheets(1).showAlldata Jeśli nie ma filtra, wyrzuci błąd, więc musiałbyś sprawdzić, Np [syntax=vb]if Sheets(1).Columns(1).AutoFilter then[/syntax] lub wyłączyć błędy (On error resume next). Trochę trudno tak w ciemno...
Witam, mam mały problem, ponieważ wyskakuje mi błąd syntax error albo expected end of statement kiedy chce wykonać [syntax=vbscript]Sub dodaj_formule() Range("f10:f300").Formula = "=JEŻELI(WYSZUKAJ.PIONOWO("Mario";'C:\Us... End Sub[/syntax]...
Można otworzyć dwa pliki w dwóch oknach w jednej instancji Excel'a Przełącza się to poleceniem w oknie imediate: Application.ShowWindowsInTaskbar = true Na pewno gdzieś w ustawieniach można to też przełączyć. Jeżeli koniecznie chcesz to z poziomu makra możesz stworzyć oddzielną instancję excel'a i do niej otworzyć. Chociaż jest to kłopotliwe bo często...
Run-time error: '1004': Method 'Range' of object 'Global' failed Dodano po 27 Język to VBA nie jestem pewna jaki syntax mam wybrać
A jeżeli makrem, to można wypróbować poniższy kod: [syntax=vb]Sub Rozdziel_Na_Kolumny() Dim rRngData As Range Dim rRngSearch As Range Dim rRngCrit As Range Dim lLstDataRw& Dim colParametr As Collection Set colParametr = New Collection Application.ScreenUpdating = False lLstDataRw = Cells(Rows.Count, 2).End(xlUp).Row Set rRngData = Range(Cells(1, 1),...
Witam raz jeszcze, Mam nadzieję, że piszę już po raz ostatni w tym temacie, ale nie daje mi on spokoju, ponieważ makro traktuje wszystkie procedury jako True. A sądząc z warunku If, jeśli nie znajdzie odpowiedniego wymiaru w tabeli, to powinno być False. Nie wiem też czemu po podświetleniu w kodzie słowa knyps, zawsze wyświetla się knyps=True, a moim...
Posiadam działającą wyszukiwarkę w Excelu, która działa tylko dla jednej kolumny [syntax=vbscript]Private Sub TextBox1_Change() ActiveSheet.ListObjects("Data1").RANGE.A... field:=2, Criteria1:="*" & [a2] & "*", Operator:=xlFilterValues End Sub[/syntax], jak zmodyfikować makro bądź utworzyć całkowicie nowe, aby działało dla wielu kolumn....
Przykładowe makro: [syntax=vbscript]Sub numery() Dim coll As New Collection Dim ow As Long, i As Long ow = Range("A" & Rows.Count).End(xlUp).Row On Error Resume Next For i = 2 To ow If Range("A" & i).Value <> vbNullString Then coll.Add coll.Count + 1, Range("A" & i).Value If Err = 0 Then Range("B" & i).Value = coll.Count Else Err.Clear...
Sub Usundane() ' ' Usundane Makro ' Makro zarejestrowane 2012-05-22, autor XYZ ' If MsgBox("Czy na pewno chcesz usunąć dane osobowe z tej tabeli? Pamiętaj, że stracisz je bezpowrotnie!!!", vbOKCancel + vbCritical + vbDefaultButton2, "UWAGA! Usuwanie danych") = vbOK Then Range("C11:AC50").ClearContents End If End Sub Zaznacza mi linię zaznaczoną przeze...
Można bez makra, Np wpisz w B2 i skopiuj/przeciągnij w dół =WYSZUKAJ.PIONOWO(A2;Arkusz2!A:B... Jeśli koniecznie VBA, to w kod arkusza wklej [syntax=vb]Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Columns(1)) Is Nothing Then On Error Resume Next Target.Offset(0, 1) = Sheets("Arkusz2").Columns(1).Find(what:=...
Jakiegoś ewidentnego błędu w tym kodzie nie znalazłem, być może jakieś przypadkowe interakcje z innym kodem. Natomiast generalnie ten kod wykonuje mnóstwo niepotrzebnych czynności i można go znacznie skrócić. Może w tej skróconej formie będzie działał lepiej (a przynajmniej w razie wystąpienia błędu łatwiej będzie go zlokalizować). [syntax=vbscript]Sub...
syntax error command syntax error excel error
pęcherz powietrza kolory przewodów zasilających krups migają wszystkie kontrolki
Oświetlenie ewakuacyjne na klatce schodowej: normy i wymagania Legal definition of battery: intentional, non-consensual physical contact explained
