Wróżę problemy z jakimikolwiek poprawkami nawet tego prostego kodu. Makro jest podpięte pod Arkusz1->Worksheet->Change.
Nie wiem co miałeś na myśli Po następnym wpisaniu daty w I4 powinno kopiować zakres dat z I4 do R4 itd. Ale pozostałe funkcje działają. [syntax=vb] Public Blokada As Boolean Sub Przesun(Wiersz As Integer) Dim a As Integer For a = 7 To 0 Step -1 ActiveSheet.Cells(Wiersz, a + 9 + 1).Value = ActiveSheet.Cells(Wiersz, a + 9).Value Next a ActiveSheet.Cells(Wiersz,...
To wypróbuj najprostsze połączenie kodów :spoko: : [syntax=vbscript]Private Sub Worksheet_Change(ByVal Target As Excel.Range) If Target.Cells.Count > 1 Then Exit Sub If IsNumeric(Target) And Target.Address = "$A$5" Then Select Case Target.Value Case 1: Firma_1 Case 2: Firma_2 Case 3: Firma_3 Case 4: Firma_4 Case 5: Firma_5 Case 6: Firma_6 Case 7: Firma_7...
Życzę powodzenia z wydajnością tego skoroszytu (jak się rozbuduje) przy uruchamianiu za każdym razem makra przez 'worksheet change'. (źle wpisane 'run' makro, pomyłka 'run' makro itd.)
Witam, Poniższe makro filtruje dane z zakresu dynamicznego "Operacje" i unikalne wartości umieszcza w zakresie dynamicznym "OperacjeSorted". Problem w tym, że w tej postaci, makro "odpala", lecz filtrowanie nie działa. Natomiast to samo makro, zapisane jako "Macro1()", uruchomione z ręki - działa OK. -- Private Sub Worksheet_Change(ByVal Target As Range)...
Ojej, nie myślałem, że weźmiesz to dosłownie ;) Już tłumaczę i objaśniam: 1. Nie możesz stosować dwóch procedur o tej samej nazwie. W Twoim przypadku zdublowałeś Worksheet_Change . 2. W poruszonej procedurze zdarzeniowej, przekazywany jest argument typy Range , zadeklarowany jako zmienna Target . Obiekt Range posiada własności (members), stąd skrót...
[syntax=vbscript]Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$C$2" Then [A2] = [A2] + [C2] [C2] = Null End If End Sub [/syntax]
[syntax=vbscript]Private Sub Worksheet_Change(ByVal Target As Range) If Target = "" Then Exit Sub[/syntax]
Chyba wygodniejsze będzie oprogramowanie zdarzenia Worksheet_Change, tylko nie zapomnij o wyłączeniu obsługi zdarzeń na czas podmiany wartości. [syntax=vbscript]Private Sub Worksheet_Change(ByVal Target As Range) If Intersect(Target, Range("C4:C6")) Is Nothing Then Exit Sub Application.EnableEvents = False If Target.Count = 1 Then Target.Value = UCase(Target.Value)...
Można postąpić tak: Odblokować wszystkie komórki w arkuszu (a przynajmniej te, które mogą podlegać edycji). Włączyć ochronę arkusza. Do kodu arkusza wpisać procedurę obsługi zdarzenia Change: [syntax=text]Private Sub Worksheet_Change(ByVal Target As Range) ActiveSheet.Unprotect Target.Locked = True ActiveSheet.Protect End Sub [/syntax] Jeśli arkusz...
A dlaczego nie wykorzystasz zdarzenia Worksheet Change? Ogranicz sobie do jednej kolumny (if target.column = 5 then) i podstaw wiersz (target.row) - argumentem Range jest string, można więc poskładać, Np[syntax=vba]Range("A" & w & ":D" & w).Value[/syntax]gdzie 'w' to target.row
[syntax=vb]Private Sub Worksheet_Change(ByVal Target As Range) If ((Target.Row - 27) Mod 4) = 0 Then Target.Offset(1).Calculate End Sub [/syntax]
[syntax=vbscript]Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column = 3 Then Cells(Target.Row + 1, 1).Select End Sub [/syntax]
Jeśli nadzorowane zmiany mają być w Arkuszu2, to procedura Worksheet_Change powinna być umieszczona w module Arkusza2. W tej procedurze można odwoływać się do Arkusza1 bezpośrednio (przez nazwę kodową) albo pośrednio przez kolekcję Worksheets jako Worksheets(1) albo Worksheets("Arkusz1"). Przykładowy kod: [syntax=vbscript]Private Sub Worksheet_Change(ByVal...
Polecam zaprzyjaźnić się z debuugerem. Pomaga na zgryzoty :D Wstawiasz break ("czerwone kółko") na początku obu funkcji, ale nie przy deklaracji zmiennych (klikając na szarym polu po lewej stronie kodu). Potem robisz jakąś akcję w excelu, np. zmieniasz arkusze, i kiedy program zatrzyma wykonywanie w zaznaczonym miejscu, wciskając F8 przechodzisz kolejne...
[syntax=vbscript]Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column > 2 And Target.Column < 14 Then Cells(Target.Row, 14) = Now() End Sub [/syntax]
Wypróbuj takie makro: [syntax=vbscript]Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column >= 2 And Target.Column <= 12 Then Cells(Target.Row, "M") = Application.UserName Cells(Target.Row, "N") = Date End If End Sub[/syntax]
A co tam w procedurach zdarzeniowych arkusza? Dla pewności dopisz Application.EnableEvents=false/true analogicznie jak z screenupdating pierwsze zdanie - strzał w 10! problemem okazała się procedura zdarzeniowa - ''Worksheet change'', więc filtrowanie traktowane było jako ''change'' i wracał na początek. Zamiast filtrowania użylam pętli do wyszukiwania...
[syntax=vb]Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column = 3 And Target.Value = 3 Then Target.Offset(0, -1) = Date - 1 End Sub [/syntax] lub [syntax=vb]Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column = 3 Then If Target.Value = 3 Then Target.Offset(0, -1) = Date - 1 Else Target.Offset(0, -1) = Date End If End...
[syntax=vbscript]Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column = 2 Then Cells(Target.Row, 1) = Now() End If End Sub [/syntax]
A tak [syntax=vbscript]Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column = 6 Then Target.Offset(, -5).Value = Date If Target.Column = 7 Then Target.Select End Sub[/syntax]
[syntax=vbscript]Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$A$1" Then Range(Cells(1, Target), Cells(1, 120)).EntireColumn.Hidden = True End Sub [/syntax]
ad 1. Można wykorzystać następujący kod dla zdarzenia Worksheet_Change arkusza: [syntax=vbscript]Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column = 12 And (Cells(Target.Row, Target.Column).Offset(, -1).Value + Cells(Target.Row, Target.Column).Offset(, -2).Value = 0) Then Target.Value = 0 End If End Sub[/syntax] ad 2. Wystarczy poprawność...
Przenieś makro do zdarzenia, 'Worksheet_Change', jak napisał Adamas. [syntax=vbscript]Private Sub Worksheet_Change(ByVal Target As Range) Application.Calculation = xlManual If Range("X25") = "" Then Range("H20:J20").ClearContents If Range("X22") = "" Then Range("H18:J18").ClearContents If Range("X18") = "" Then Range("H14:J16").ClearContents If Range("X13")...
[syntax=vbscript]Private Sub Worksheet_Change(ByVal Target As Range) Application.EnableEvents = False If Not Intersect(Target, Range("c4:c35")) Is Nothing Then Target.Offset(0, 1).Select ActiveCell.ClearContents Application.EnableEvents = True End If End Sub[/syntax] teraz makro ruszyło. ale gdy manipuluję komórka np. d4 przestaje działać i dopiero...
[syntax=vbscript]Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column = 4 And Target = "Pranie" Then Range("E" & Target.Row) = Date End Sub[/syntax] Ale czy czasami nie potrzebujesz funkcji?
Można jeszcze tak. (dla pojedynczych danych) [syntax=vbscript]Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column <> 1 Then Exit Sub If Target.Count > 1 Then Target = "": Exit Sub If Application.CountIf(Columns(1), Target) > 1 Then Target = "" End Sub[/syntax]
Private Sub Worksheet_Calculate() Rows("6:12").Entir... = Not Range("B1") End Sub Dodano po 56 Private Sub Worksheet_Change(ByVal Target As Range) - nie trzeba
w arkuszu roboczym Zrob przeliczane manualnie, tylko w kodzie arkuszu(roboczy) wpisz [syntax=vb]Private Sub Worksheet_Change(ByVal Target As Range) Me.Calculate End Sub[/syntax]
[syntax=vbscript]Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column = 12 And Target = "przegrany" Then If Cells(Target.Row, "M") = "" Then MsgBox "Wprowadź komentarz!", vbCritical, "UWAGA" End If End Sub [/syntax]
[syntax=vb]Private Sub Worksheet_Change(ByVal Target As Range) If Intersect(Target, Range("H:H")) Is Nothing Then Exit Sub If Target = "fail" Then MsgBox "Do poprawy" End Sub [/syntax]
Można do tego wykorzystać makro zdarzeniowe, na przykład takie: [syntax=vbscript]Private Sub Worksheet_Change(ByVal Target As Range) Dim cel As Range Application.EnableEvents = False For Each cel In Target If Len(cel) > 0 Then If Left(cel, 1) <> "'" Then cel.Value = "'" & cel.Value End If Next cel Application.EnableEvents = True End Sub...
Oczywiście jest taka możliwość, Np wykorzystując zdarzenie arkusza 'Worksheet_Change'. Za to "mail'ować" z Excela można na kilka sposobów (łącznie z wykorzystaniem Excela jako programu/klienta pocztowego). I tu potrzebna informacja który sposób wykorzystujesz (albo masz zamiar).
Jest to zrobione makrem zdarzeniowym Worksheet_Change, reagującym na zmianę wartości w komórkach B9:D9. Makro jest w module arkusza, w którym jest formularz. Treść makra: [syntax=vbscript]Private Sub Worksheet_Change(ByVal Target As Range) If Target(1).Address = Range("f_rodz_nieruchomosci").Address Then Rows("33:76").Hidden = True With Worksheets("Legenda")...
w kodzie arkuszu [syntax=vb]Private Sub Worksheet_Change(ByVal Target As Range) If Not Application.Intersect(Columns(1), Target) Is Nothing Then Me.Unprotect With Target.Offset(, 1).Resize(, 2) .Locked = Target = 0 .ClearContents End With Me.Protect End If End Sub [/syntax]
Dla przykładu No właśnie dla przykładu, to przydałby się przykładowy plik. Dodano po 4 Nie pisz na PW proszę, skoro plik dotyczy tematu.
[syntax=vb]Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("V15:V16")) Is Nothing Then If Target.Address = "$V$16" Then r = 1 Target.Offset(-10 - r, 3).Resize(2, 2).Copy Target.Offset(r * 2, 2) End If End Sub [/syntax]
[syntax=vbscript]Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$C$2" Then Application.ScreenUpdating = False nw = Sheets("Baza").Cells(Rows.Count, "A").End(xlUp).Row + 1 Range("A2:C2").Copy Sheets("Baza").Cells(nw, 1).PasteSpecial xlPasteValues Range("A2").Select Application.CutCopyMode = False Application.ScreenUpdating =...
Wklej w kod arkusza (nie w moduł) [syntax=vbscript]Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address(0, 0) = "N7" Then If Target.Value <> Empty Then Rows(7).Insert Shift:=xlDown End If End Sub[/syntax]
Private Sub Worksheet_Change(ByVal Target As Range) Dim Komorka As Range If Not Application.Intersect(Rows(5), Range(Target.Address)) Is Nothing Then For Each Komorka In Target.Cells Select Case Komorka.Value Case "TAK": . . . End Select Next End If End Sub
Wytłumaczenie dosyć proste: użyłeś zdarzenia odpalanego przy jakiejkolwiek zmianie w którymkolwiek arkuszu, bez żadnych dodatkowych zabezpieczeń/warunków... Jeżeli to makro wypisuje jakąkolwiek wartość do innej komórki, automatycznie odpala kolejne zdarzenie i program się zapętla... Zamiast globalnego zdarzenia, użyj zdarzenia Worksheet_Change w arkuszu...
[syntax=vb]Private Sub Worksheet_Change(ByVal Target As Range) If Target.Value <= 10 Then MsgBox "Wartość poniżej 10!", 64, "Wesołych Świąt" End If End Sub[/syntax]A teraz? Procedurę wklejasz w kod arkusza...
[syntax=vb]Private Sub Worksheet_Change(ByVal Target As Range) On Error Resume Next r = Date - Target.Cells If Target.Column = 2 And r > 30 Then w = Target.Row Cells(w - 1, 5) = "" Cells(w, 5) = "" End If End Sub [/syntax]
https://obrazki.elektroda.pl/5102527300_... https://obrazki.elektroda.pl/1962866400_...
Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column = 3 Then Target.Offset(0, -2) = Date Target.Offset(0, -1) = Year(Date) & "/" & Target.Row - 1 End If End Sub
Można tak:[syntax=vb]Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column = 1 And Target.Row > 1 Then For Each c In Target If c.Value = "" Then Cells(c.Row, "B").Value = "" Else Cells(c.Row, "B").Value = Date End If Next c End If End Sub [/syntax]
Rozumiem, że masz świadomość, że na samej liście rozwijanej kolorów nie będzie widać, bo taka już jej uroda. Natomiast można ustawić kolor za pomocą makra zdarzeniowego Worksheet_Change na podstawie wyboru z listy. Zakres komórek wzorcowych ma nazwę "Wzornik". Sprawdzanie poprawności trzeba ustawić ręcznie, pamiętając o wyłączeniu alertów. Komórki ze...
ukryje kolumnę np. F w chwili kiedy zostanie wypełniona ostatnia komórka kolumny w tabeli To zastosuj kod typu :spoko: : [syntax=vbscript]Private Sub Worksheet_Change(ByVal Target As Range) Set Target = Range("F2:F11") If IsEmpty(Target) = False Then Columns(Target.Column).Hidden = True ActiveSheet.Range("a1").Select End Sub [/syntax]
W kodzie arkuszu "konto"[syntax=vb]Private Sub Worksheet_Change(ByVal Target As Range) If Application.Intersect(Target, Range("L4:M2003")) Is Nothing Then Exit Sub If Target.Text = "0" Then Target = "NIE DOTYCZY" End Sub [/syntax]
Kłopot polega na tym że dla excela zmiana kolory nie jest "podstawą" włączenia przeliczenia. Wyjściem jest albo po zmianie koloru wciskać F9 lub w "sekcji" Worksheet_Change(ByVal Target As Range) danego arkusza uzależnić/wymusić przeliczenie ( Calculate ) od zmiany koloru.
W komórce z formułą włącz zawijanie tekstu, a oprócz tego w module arkusza zdefiniuj sobie takie makro zdarzeniowe: [syntax=vbscript]Dim kom Private Sub Worksheet_Calculate() With Range("B8") If IsError(.Value) Then .Rows.AutoFit kom = 0 ElseIf .Value <> kom Then .Rows.AutoFit kom = .Value End If End With End Sub [/syntax]Alternatywnie możesz...
Myślę, że sprawdzanie czy [syntax=vbscript]If Range("C1") = "" Then Range("C1") = Range("A1") Else ...[/syntax] jest tu niepotrzebne - pusta wartość C1 będzie potraktowana jako 0. Ja bym to widział nieco krócej: wersja "jednokomórkowa"[syntax=vbscript]Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$A$1" And IsNumeric(Target.Value)...
Albo:[syntax=vb]Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$B$5" Then If Application.CountIf(Range("A1:A4"), Target) = 0 Then Target.Interior.Color = vbRed Else Target.Interior.ColorIndex = xlNone End If End If End Sub [/syntax]
Mi jednak chodzi o to by makro się samo uruchamiało. Tu masz makro, które monitoruje określony zakres pod kątem zmiany. Dodaj do tego kod swojego makra sortującego. [syntax=vbscript]Private Sub Worksheet_Change(ByVal Target As Range) Dim KeyCells As Range ' The variable KeyCells contains the cells that will ' cause an alert when they are changed. Set...
Był błąd w kodzie. [syntax=vbscript]Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column = 2 Then r = Target.Row If Cells(r, 3) = "" Then Cells(r, 3) = Now & " - " & Target & " - " & Environ("Username") Else Cells(r, 3) = Cells(r, 3) & vbNewLine & Now & " - " & Target & " - " & Environ("Username") End If End If End Sub [/syntax]
Np. dla zakresu A1:B5 Od początku powinno być odblokowany. [syntax=vb]Private Sub Worksheet_Change(ByVal Target As Range) Dim zakres As Range Set zakres = Range("A1:B5") If Intersect(Target, zakres) Is Nothing Then Exit Sub Me.Unprotect 'haslo Target.Locked = True Me.Protect 'haslo End Sub [/syntax]
dodanie takiego makra jak poniżej, nie wyświetla mi napisu "hello" Popełniasz błędy: - wprowadzając "prywatne makro arkuszowe" do modułu uniwersalnego :cry: , jeśli to samo makro wkleisz do modułu arkusza "zamówienia" i dokonasz zmiany treści komórki - zamiast ujętej tam formuły wprowadzisz tam 1 - to uzyskasz Twój pożądany efekt - "hello" :D ; - nie...
Jeśli zmiana nieparzystego wiersza ma wywoływać "timestamp" to proponuję raczej :D kod typu: [syntax=vbscript]Private Sub Worksheet_Change(ByVal Target As Range) Set Zak = Intersect(Target, Range("I1:FK100")) If Not Zak Is Nothing Then Application.EnableEvents = False If Target.Row Mod 2 = 1 Then Target.Offset(1, 0) = Date End If End If Target.Columns.EntireColumn.AutoFit...
Może najpierw funkcja, która zaznaczy komórki żółte, a potem je zabezpieczy przed zmianą. Plik z możliwością działania makr (xlsm, xls) :idea: w arkuszu roboczym wprowadź taki kod makra :spoko: [syntax=vbscript]Private Sub Worksheet_Change(ByVal Target As Range) Unprotect "a" Target.Interior.ColorIndex = 6 Target.Locked = True Protect "a" End Sub[/syntax]...
Testuj kolumnę, przypisuj na offsetach. Np[syntax=vb]Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column = 1 Then If Target.Value = "x" Then 'Range("C1") = Range("B1") Target.Offset(0, 2) = Target.Offset(0, 1) Else 'Range("C1") = "" Target.Offset(0, 2) = "" End If End If End Sub[/syntax]
Nie to zdarzenie, nie taka składnia, reszta OK...[syntax=vb]Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("A1:A6")) Is Nothing Then On Error Resume Next 'gdybyś czyścił zakres Application.EnableEvents = False Target.Value = Replace(Target.Value, " ", Chr(10)) Application.EnableEvents = True End If End Sub[/syntax]
W takim razie w arkuszu z tą komórką wstaw taki fragment: [syntax=vb]Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$B$9" Then Call myCopy End If End Sub[/syntax] Nazwa makra - copy() - nie jest zbyt fortunna, bo pokrywa się z poleceniem VBA o takim samym tytule. Lepiej zmień ją np. na myCopy
Daj to w kodzie danego arkusza ("adres twojej komórki" musisz podać adres tej komórki co odbiera co min. te dane) [syntax=vbscript]Private Sub Worksheet_Calculate() Application.EnableEvents = False Cells(Rows.Count, 5).End(xlUp).Offset(1) = "adres twojej komórki" Application.EnableEvents = True End Sub[/syntax] lub pod [syntax=vbscript]Private Sub Worksheet_Change(ByVal...
Możesz użyć takiego makra zdarzeniowego: [syntax=vbscript]Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column <> 3 Then Exit Sub If Target.Count > 1 Then Exit Sub If Target.Value = "B" Then Application.EnableEvents = False Cells(Target.Row, 2).Value = WorksheetFunction.Max(Columns(2)) + 1 Application.EnableEvents = True End...
Nie chciało się spytać wujka google o właściwość Font.Color dla obiektu Range i obsłużyć zdarzenie Worksheet_Change(ByVal Target As Excel.Range) arkusza w którym kolory mają być zmieniane? To tylko jedna linijka kodu pisana z palca.
A Excel w ogóle poradzi sobie z rysowaniem wykresu / obliczaniem makra w tak krótkim okresie czasu? Masz 333 próbki na sekundę, ok. 20000 na minutę. Zrobiłem z ciekawości wykres na 20000 wartości i rysuje się ok. 0,1s bez wykonywania makra. Ja nie widzę żeby on mógł się odrysować w ciągu 0,003s. Ale jak chcesz spróbuj w arkuszu z danymi podpiąć makron...
W edytorze makro w danym arkuszu (worksheets) w sekcji Change wpisz: Private Sub Worksheet_Change(ByVal Target As Range) If Range("c11").Value <> "" And Range("b11").Value = "" Then Range("d11").Value = Now() Else Range("d11").Value = ""...
To był przykład. [syntax=vbscript]Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$A$1" Then w = Application.Match(Target, Range("C1:C" & Cells(Rows.Count, "C").End(xlUp).Row), 0) If Not IsError(w) Then For x = 5 To 9 If Cells(w, x) = "" Then Cells(w, x).Select Exit For End If Next End If End If End Sub [/syntax]
Jeśli jest to lista przez poprawność danych to najlepiej wykorzystać zdarzenie arkusza. Np (w kodzie arkusza) Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address(0, 0) = "E1" Then Columns(1).Find(what:=Ta... Lookat:=xlWhole).Select End If End Sub W przypadku obiektu (pole kombi,...
To się baw. Sprawdzanie PESELa znajdziesz w sieci. [syntax=vbscript]Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$C$12" Then If Target = "Tak" Then Range(Rows(13), Rows(14)).Hidden = True Else Range(Rows(13), Rows(14)).Hidden = False End If End If If Target.Address = "$C$15" Then If Target = "Tak" Then Range(Rows(16), Rows(17)).Hidden...
O coś takiego chodzi? [syntax=vbscript]Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$A$1" Then Select Case Target.Value Case "a" Range("B3").Value = Range("B3").Value + 1 Case "b" Range("B4").Value = Range("B4").Value + 1 Case "c" Range("B5").Value = Range("B5").Value + 1 End Select End If End Sub[/syntax]
[syntax=vb]Private Sub Worksheet_Change(ByVal Target As Range) On Error Resume Next If Target.Column = 5 Then nw = Sheets("Logistyka").Cells(Rows.Count, "A").End(xlUp).Row + 1 If nw = 2 Then nw = 1 w = Target.Row Range(Cells(w, 1), Cells(w, 5)).Copy Sheets("Logistyka").Cells(nw, 1).PasteSpecial xlPasteValues End If End Sub [/syntax] Kod na tyle prosty,...
Eee tam, wiesz, tylko pewnie myślisz już o Sylwestrze :) Select Case Target Case "A": Sheets("Arkusz5").Rang... 1) = "8" Case "B": Sheets("Arkusz5").Rang... 1) = "U" End Select
zrobic jedna komorke w ktorej bede wpisywal litere Np komorka jest "G1" [syntax=vb] Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$G$1" Then If Not Application.CountIf(Range("F:F"), Target) = 0 Then ActiveWindow.ScrollRow = Application.Match(Target, Range("F:F"), 0) End If End If End Sub [/syntax]
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.....
Najlepiej wykorzystać zmianę w kalendarzu. Wklej w kod arkusza "Kalendarz" [syntax=vb]Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$H$18" Or Target.Address = "$I$18" Then With Sheets("Szychtownica") For i = 34 To 32 Step -1 If .Cells(2, i).Value = "" Then .Columns(i).EntireColumn.Hidden = True Else .Columns(i).EntireColumn.Hidden...
W kod arkusza wklej[syntax=vb]Private Sub Worksheet_Change(ByVal Target As Range) If Target.Count = 1 And Target.Column = 5 And Target.Value <> "" Then wrs = Columns(5).Find(what:=Target.Value, lookat:=xlWhole).Row Target.Offset(0, 1) = IIf(Target.Row = wrs, "", Cells(wrs, 6)) End If End Sub[/syntax]W przypadku braku odpowiednika znajdzie sam...
Wklej w kod arkusza(y) i wypróbuj taką procedurę zdarzeniową [syntax=vb]Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column = 4 Then With Sheets("Arkusz3") w = .Range("B:B").Find(what:=Target.Offset(0... -2), Lookat:=xlWhole).Row k = .Cells(w, 1).End(xlToRight).Column + 1 .Cells(w, k) = Target.Value End With End If End Sub[/syntax]
Trzeba dopisać do kodu jedną linijkę i zakończenie instrukcji warunkowej (bo już nie zmieści się w 1 linijce): [syntax=vb]Private Sub Worksheet_Change(ByVal Target As Range) On Error Resume Next If Intersect(Target, Range("I:I")) Is Nothing Then Exit Sub If Target = 2 Or Target = 3 Then Range("J" & Target.Row & ":AP" & Target.Row) = 0 Range("AQ" & Target.Row).Select...
Wklej w kod arkusza :[syntax=vb]Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address(0, 0) = "C47" Then If LCase(Target.Text) = "przelew" Then 'Przelew, PRZELEW, przelew Rows("48:49").EntireRow.Hidden = False Else Rows("48:49").EntireRow.Hidden = True End If ElseIf Target.Address(0, 0) = "C47:E47" Then 'jeśli pusta też ma odkrywać to...
1. Początkowo w formatowani komórek odblokować zakres B:I 2. Włączyć ochronę arkusza. (np. z hasłem 111 ) 3. Umieścić w kod Arkusz1 ten kod: Private Sub Worksheet_Change(ByVal Target As Range) If Intersect(Target, Range("B:I")) Is Nothing Or Cells(Target.Row, 1) <> "" Then Exit Sub Me.Unprotect...
A nie wystarczy sprawdzanie poprawności danych - opcja pełna liczba i podać zakres od 0 albo od 1 do ile potrzeba. Jeśli dane wprowadzane z klawiatury i użytkownik nie jest złośliwy, to powinno wystarczyć. Co innego jeśli dane są kopiowane z innych komórek, wtedy ten mechanizm nie działa. Wstawiłem do A1. Komunikat MsgBox można wyświetlić przy zmianie...
Może coś w tym stylu, jedynie o poprawność danych na drugiej liście musisz zadbać samemu: /pierwsza lista w A2, druga w B2/ [syntax=vbscript]Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$A$2" Then Select Case Target.Value Case "biały": Range("B2").Value = "czarny" Case "zielony": Range("B2").Value = "czerwony" Case "żółty":...
Wklej w kod arkusza[syntax=vb]Private Sub Worksheet_Change(ByVal Target As Range) Dim test As Integer If Target.Count > 1 Then Exit Sub test = InStr(1, Target.Value, "+") If test = 0 Then Exit Sub Application.EnableEvents = False On Error Resume Next Target.Value = "=" & Target.Value Application.EnableEvents = True End Sub[/syntax]Procedura reaguje...
Proponuję makro zdarzeniowe przy założeniu, że adresy komórek z listami wyboru będą stałe. Można byłoby też wyszukiwać listy rozwijane gdyby ich adresy miały być ruchome. [syntax=vbscript]Private Sub Worksheet_Change(ByVal Target As Range) If Target = "TAK" Then Select Case Target.Address Case "$G$2": Range("G8").Select Case "$G$8": Range("G12").Select...
To już tylko z makrem. Inaczej się nie da. W obszarze arkusza "gwarancja" wprowadzasz np. Private Sub Worksheet_Change(ByVal Target As Range) If Target.Row = 11 And Target.Column = 2 Then Range("E11").Formula = "=VLOOKUP(B11,Lista!A1:B500... End Sub I przy każdej zmianie w b11 (row 11 i column2) nastąpi...
[syntax=vbnet]Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column = 3 Then w = Target.Row If Cells(w, 1) = "TekstA" And Cells(w, 2) = "TekstB" Then Select Case Target Case Is < 10 Cells(w, 4).Font.Color = vbGreen Case Is = 10 Cells(w, 4).Font.Color = vbYellow Case Is > 10 Cells(w, 4).Font.Color = vbRed End Select End If End If...
Np taką procedurą zdarzeniową (wklej w kod arkusza)[syntax=vb]Private Sub Worksheet_Change(ByVal Target As Range) Dim wrs As Integer If Not Intersect(Target, Range("B9:B20")) Is Nothing Then If Target = "wybierz z listy" Then wrs = Target.Row + 23 'czyścimy Target.Offset(0, 1) = 0 Cells(wrs, 6) = 0 Cells(wrs, 7) = 0 End If End If End Sub[/syntax]Rozumiem,...
Makra włączone? Może problem z nazwa/indeks. Spróbuj Private Sub Worksheet_Change(ByVal Target As Range) On Error GoTo byk If Target.Column = 1 Then Sheets(Trim(Str(Target.Row&#... = Target.Value End If Exit Sub byk: If Target.Value <> "" Then MsgBox "Brak arkusza o...
Umieść ten kod w zdarzeniu arkusza. Dodaj na początek jakieś sprawdzanie, żeby cały kod nie wykonywał się, jak nie musi i to wszystko. [syntax=vbscript]Private Sub Worksheet_Change(ByVal Target As Range) [/syntax] P.S. Kod nie jest dobrze napisany. Zmienna 'k' powinna być przed pętlą, a nie w niej. Pętlę: [syntax=vbscript]For l = 1 To 20 For k = 2 To...
ale "Jelczan" prosił o makro Aaa, to najprościej oprogramować zdarzenie (co sugerował już kolega PRL ), Np [syntax=vbscript]Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("a2:a100")) Is Nothing Then If Target = "" And Target.Offset(0, 1) <> "" Then Range(Target, Target.Offset(0, 10)).Interior.ColorIndex = 6...
[syntax=vbscript]Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$A$10" Then Application.EnableEvents = False Range("A11:A" & Cells(Rows.Count, "A").End(xlUp).Row).ClearContents ow = 5 ok = Cells(1, Columns.Count).End(xlToLeft).Column x = Target.Row + 1 For k = 1 To ok Set a = Range(Cells(1, k), Cells(ow, k)).Find(Target, LookIn:=xlValues,...
Teraz wszystko jasne. [syntax=vbscript]Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column = 2 Then Application.ScreenUpdating = False Plik = "C:\PlikiSpraw\" & Range("A" & Target.Row) & ".xlsx" If Dir(Plik) <> "" Then Rows(Target.Row).Copy Set s = Workbooks.Open(Plik) nw = s.Sheets(1).Cells(Rows.Count, "A").End(xlUp).Row...
[syntax=vbscript]Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$E$7" Then r = Year(Target) m = Month(Target) d = Day(Target) Data = CDate(r & "-" & m & "-" & d) ActiveSheet.PivotTables("wazenie").Pivot... = r & "/" & m & "/" & d End If d = Format(Data, "dd.mm") ActiveSheet.ChartObjects("Wykres 1").Activate...
Nie zrozumiałem..., a z którego fragmentu Twojego tekstu: Czy można zrobić tak, żeby w miejsce kropek wpisywać tekst (i kropki zeby zostały zastąpione przez tekst a nie przesunięte). wynika to co ostatnio napisałeś? niezrozumiałeś mnie... chce zeby kropki zostało i przed tekstem i za tekstem... Odpowiadając - można to zrobić np. tak: Private Sub Worksheet_Change(ByVal...
Problem nie jest całkiem prosty, bo jakby był prosty, to sam znalazłbyś rozwiązanie. Nie da się sformatować wybiórczo (w sensie każdy znak osobno) wyników formuły. Cały wynik formuły musi być sformatowany jednakowo. Formatowanie wybiórcze jest możliwe tylko w przypadku stałych tekstowych. Można tu zastosować kopiowanie, tylko kłóci się ono jeszcze ze...
Najlepiej jak by się to dało zmienić (wstawić) na pustopole Da się chyba. Spróbuj Private Sub Worksheet_Change(ByVal Target As Range) On Error GoTo koniec If Not Intersect(Target, Range("B13:F13")&#... Is Nothing Then If Target.Count > 1 Then Exit Sub If Target <= 0 Then Target = "": Exit Sub Call...
Spróbuj tak: [syntax=vbscript] Option Explicit Private a Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Not Intersect(ActiveCell, Range("C:E")) Is Nothing Then a = ActiveCell End Sub Private Sub WorkSheet_Change(ByVal Target As Range) Dim i As Integer i = Target.Row If Target.Column = 3 Or Target.Column = 4 Or Target.Column = 5 Then...
Blokowanie uzyskasz poprzez założenie hasła. Numerowanie komentarzy poniżej. [syntax=vbscript]Private Sub Worksheet_Change(ByVal Target As Range) Dim a As String If Not Application.Intersect(Range("A1:C10"), Range(Target.Address)) Is Nothing Then i = Environ("USERNAME") & " <" & Now & ">" & vbNewLine & Target & vbNewLine...
Kod który Ci podawałem ostatnio działa tylko dla jednej kolumny, takiej samej jak Target.Column. U Ciebie nie działa bo funkcja Intersect() [zwracająca wspólną część dwóch zakresów] poza 15-tą kolumną jest teraz wywoływane na nie takich zakresach jak trzeba. Zmień początek tego makra na taki: [syntax=vb]Private Sub Worksheet_Change(ByVal Target As Range)...
worksheet match change section change language
czujnik indukcyjny regulacja sufitowe głośniki klimatyzacja zamarza
wybór lodówki schemat bezpieczników skoda octavia
Cobra GT900 nie hamuje – diagnostyka pedału, potencjometr, firmware GT9xx_v3.1 Błąd F.81 w kotle Saunier Duval - przyczyny i rozwiązania
