[syntax=vbscript]Target = Target & Now[/syntax]
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]
[syntax=vbscript]Private Sub Worksheet_Change(ByVal Target As Range) If Target = "" Then Exit Sub[/syntax]
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...
[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]
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]
Private Sub Worksheet_SelectionChange(... - jest reakcję na zmianę położenia kursora w arkuszu. (zdarzenie arkusz_ZmianaZaznaczenia) If Target.Column <> 12 Then Exit Sub- tylko dla kolumny L, w przeciwnym razie przerwać pracę. W Twojim przypadku[syntax=vb]Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.Column = 12 Then Range("a7")...
[syntax=vbscript]Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column = 3 Then Cells(Target.Row + 1, 1).Select End Sub [/syntax]
Co w przypadku jesli klikasz na B6, lub F4 itp.? Dodano po 3 w kodzie arkusza[syntax=vb]Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.Count = 1 And Target.Column = 1 Then Cells(1, 1) = Cells(Target.Row, 1) End Sub [/syntax]
A w taki sposób próbowałeś? [syntax=vb]Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$B$2" And Target.Value <= 10 Then MsgBox "Wartość poniżej 10!", 64, "Wesołych Świąt" End If End Sub[/syntax]
Podmień Target na ActiveCell (to nie jest już procedura zdarzeniowa)...
[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?
Skoro nie chcą, zrezygnuj z listy i wstaw formułkę (niestandardowe): [syntax=text]=ORAZ(PODAJ.POZYCJĘ(C4;J$6:... Jeśli jednak makro, to w SelectionChange (ogranicz 'Target' do tych trzech komórek).
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
klikając na konkretną komórkę 2 x klik: [syntax=vbscript]Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Target.Address = "$K$11" Then UserForm1.Show Cancel = True End If 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
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]
[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...
Wygodniej tak: [syntax=vbscript]Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Target.Column = 1 Then Rows(Target.Row).Delete Cancel = True End If End Sub [/syntax]
[syntax=vbscript]Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Target = "u" And Target.Interior.Color = vbYellow Then Target.Interior.Pattern = xlGray25 Cancel = True End Sub [/syntax]
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...
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...
[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]
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]
[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]
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ść...
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.
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]
Autofilter 'złapie się' tylko na calculate Przenieś zdarzenie selection change na doubleclick [syntax=vbscript]Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) ActiveWorkbook.Names("AktywnyWiersz").Re... = Target.Row End Sub[/syntax]
Korzystając z opisów kolegów np. z tego wątku https://www.elektroda.pl/rtvforum/viewto... oraz przenosząc sumowanie w Arkuszu2 z dołu do góry (łatwiej znaleźć pierwszą pustą komórkę w kolumnie) możesz użyć takiej procedury: Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Target.Row...
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]
Cześć. Sprawdź takie makro wykonywane w zdarzeniu "Change" arkusza: [syntax=vbnet]Private Sub Worksheet_Change(ByVal Target As Range) If Target.Count <> 1 Then Exit Sub If (Target.Column = 1 And Target.Offset(0, 2).Value = "") Then Target.Offset(0, 2).Value = Date End If End Sub[/syntax]
If Target.Column > 2 Then Exit Sub If Target <> 0 Then Target.Offset(, 1 + Target.Column ) = Target.Offset(, 1 + Target.Column ) + Target
Że tak się wtrącę ... Nie uczysz się :) Spróbuj załapać o co chodzi w kodzie (przeczytać go) a sam zaczniesz pisać kody uzależnione od zmian w arkuszu. (if) jeżeli (Target.Column = 6) zmiana dotyczy kolumny nr 6 czyli F (AND) oraz (UCase(Target.Value) = "K") zmieniana wartość zmieniona na duże litery równa jest K (Then) wtedy (Target.Value = "Komunalne")...
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]
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...
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,...
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]
Najprawdopodobniej zaznaczasz >1 komórkę. Dopisz warunek: [syntax=vb]Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) If Sh.Index > 10 Then If Target.Cells.Count = 1 Then If Target.Address(0, 0) = "A1" And Target.Value <> "" Then Sh.Name = Target.Value End If End If End If End Sub[/syntax]
Problem z tym kodem polega na tym, że gdy A2 jest zapisane to po wpisaniu C2 nic sie nie dzieje Powinno być. [syntax=vbscript]If Intersect(Target, Range("C:C")) Is Nothing Or Cells(Target.Row, 1) = "" Then Exit Sub[/syntax]
:arrow: bobo InStr Trzeba podstawić[syntax=vb]Private Sub Worksheet_Change(ByVal Target As Range) Dim test As Integer If Target.Count > 1 Then Exit Sub If Not Intersect(Target, Range("Q58:V119")) Is Nothing Then test = InStr(1, Target.Value, "+") If test = 0 Then Exit Sub Application.EnableEvents = False On Error Resume Next Target.Value = "=" & Target.Value...
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)...
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.
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...
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...
Oj, bo nie doczytałem. Chcesz usuwać dane z H,I,J,K, zostawiając formułę w L. To wykorzystaj SelectionChange w kolumnie P, gdzie widać tekst "Dodaj". [syntax=vb]Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.Column = 16 And Target.Value = "DODAJ" Then MsgBox Target.Row End If End Sub[/syntax]
Spróbuj w ten sposób [syntax=vb]Private Sub Worksheet_Change(ByVal Target As Range) Dim szukana As String, i As Long, knyps As Boolean If Target.Column = 9 Then 'wypełnia się od lewej ósma jest przed i = 3 knyps = False szukana = Trim(Target.Offset(0, -1).Value) & Trim(Target.Value) With Sheets("ListJobs") Do While .Cells(i, 3) <> "" If Trim(.Cells(i,...
Proszę. [syntax=vbscript]Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Target.Column = 1 Then r = Target.Row nw = Sheets("Arkusz2").Cells(Rows.Count, "A").End(xlUp).Row + 1 Range("A" & r & ":E" & r).Copy Sheets("Arkusz2").Cells(nw, 1) End If Cancel = True End Sub [/syntax]
W kodzie arkusza [syntax=vbscript]Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Target.Column = 1 Then Target.Resize(, 2).Interior.Color = vbRed Sheets("Arkusz2").Cells(Rows.Count, 1).End(xlUp).Resize(, 2).Offset(1) = Target.Resize(, 2).Value Cancel = True End If End Sub[/syntax]
[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]
Najprościej: Nazwij zakres (nadaj nazwę Np "zakres") w arkuszu. Wstawienie lub usunięcie wiersza/komórek wewnątrz zdefiniowanego zakresu spowoduje automatyczną korektę jego rozmiaru. Wtedy[syntax=vb]If Not Intersect(Target, Range("zakres")) Is Nothing Then[/syntax]
Zobacz teraz: [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, 9).Value = Null If ActiveSheet.Cells(Wiersz, 17).Text <> "" Then ActiveSheet.Cells(Wiersz, 18).Insert Shift:=xlToRight...
mam wardosc w a2 i teraz chce zeby pojawila sie w c3 nastepnie w c4, c5 c6 itd wartosc komorki a2 bedzie sie zmieniac a tamte wartosci sie zapamietaja Samo się nie zapisze. Wklej w kod arkusza (prawym klawiszem w zakładkę u dołu ekranu i wybierz "wyświetl kod") taki [syntax=vb]Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address(0,...
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]
Jeśli nie ma górnego ograniczenia dla wprowadzanych liczb procedurę Walidacji można zapisać też tak: [syntax=vb]With ark.Range("E6:F" & dstW).Validation .Delete .Add Type:=xlValidateWholeNumber, AlertStyle:=xlValidAlertStop, _ Operator:=xlGreater, Formula1:="0" .IgnoreBlank = True .InCellDropdown = True .InputMessage = "Wprowadź liczbę całkowitą" .ShowInput...
Moja propozycja - kod do umieszczenia w module arkusza: [syntax=vbscript]Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column > 2 Or Target.Value = "" Then Exit Sub Select Case Target.Column Case 1 Call UtworzFolder(Target.Value) Case 2 If Target.Offset(0, -1).Value <> "" Then Call PrzeniesFolder(Target.Offset(0, -1).Value)...
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)...
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...
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...
[syntax=vb]Private Sub Worksheet_SelectionChange(ByVal Target As Range) If ActiveSheet.ProtectionMode = False Then ActiveSheet.Protect Password:="haslo" 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 =...
Jeśli ma to działać w jakimś jednym konkretnym arkuszu, to w module kodu tego arkusza umieść taką procedurę: [syntax=vbscript]Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Target.Address = "$B$2" Then Sheets("1").Activate Cancel = True End If End Sub[/syntax] A to co dopisałeś, to nie bardzo rozumiem. "Do poniższego...
[syntax=vb]Sub Worksheet_Change(ByVal Target As Excel.Range) If Target.Column = 1 then Cells(Target.Row, 4). Select If Target.Column = 4 Then Cells(Target.Row + 1, 1).Select End Sub[/syntax]
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...
[syntax=vbscript]Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$A$10" Then Application.EnableEvents = False Range("A11:B" & 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,...
to makro do "zabawy" Dodano po 2 jeszcze dwie wersje.... Pierwsza ile_wierszy, to może być niemal dowolna liczba sprawdzonych wierszy , można wpisać nawet tyle ile wierszy ma cała kolumna (zależy od wersji Excela) Chodzi o to by nie sprawdzać całej kolumny bo to może potrwać.... Skopiowane zostaną tylko niepuste komórki. [syntax=vba] Sub copy_cells()...
[syntax=vb]Dim przed Private Sub Worksheet_Change(ByVal Target As Range) Dim i As Long With Target If .Cells.Count > 1 Then Exit Sub If .Column > 5 Or .Column < 3 Then Exit Sub End With If Target.Value = przed Then Exit Sub Application.EnableEvents = False i = Target.Row Range("A" & i).Value = Environ("Username") Range("B" & i).Value...
A orientujesz się może czy można zrobić tak żeby po zeskanowaniu zamiast potwierdzenia ENTER, przenosiło mnie do wskazanej komórki gdzie od razu mógłbym wpisać ilość, tzn. skan --> automatyczne przeniesienie do kolumny ilość --> ręczne wpisanie ilości i po naciśnięciu enter przejść od razu do kolumny kodu, wiersz niżej, tak żeby skanować kolejny produkt....
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
No to już tylko makro. Np takie Sub Wpisz_Jest() Columns("A:A").Sel... On Error Resume Next wiersz = Selection.Find(What:=Range(&... After:=ActiveCell, LookAt:=xlWhole).Row Cells(wiersz, 3) = "Jest" Cells(1, 2).Select End Sub Możesz je umieścić w kodzie arkusza...
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 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...
Dobry wieczór, Nie da się chyba tego zrobić w sposób oczywisty, ale jakoś można, stosując pewne "sztuczki". Przede wszystkim w komórkach, w których mamy wprowadzać dane i wykonywać obliczenia muszą być odpowiednio sformatowane (niestandardowo). Podam 3 sposoby (żaden nie jest idealny, ale jest z czego wybrać). Sposób 1 - najbardziej naturalny Format...
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 Excel.Range) If Target.Column = 8 Then h = Split("WIN;BOK;CC;OP", ";") hv = Target.Value For x = 0 To UBound(h) If hv = h(x) Then fl = True Next If Not fl Then MsgBox "Błąd" End If End Sub [/syntax]
Strasznie to wszystko zakręcone, a na dodatek niepotrzebnie komplikujesz sobie życie... Tak naprawdę to by to wszystko można zrobić na funkcjach, bez użycia VBA. No, ale... Zacznijmy od tego że poprzednie makro się wywalało, bo w złym miejscu umieściłeś sprawdzanie warunku: jeżeli masz zdarzenie Change wywoływane zmianą w arkuszu, to jeżeli w tym zdarzeniu...
Przy podwójnym kliknięciu to będzie coś takiego: [syntax=vb]Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Target.Column > 2 And Target.Column < 6 Then UserForm1.Show End If End Sub [/syntax]
Podałeś taki niestandardowy format z łącznikami między elementami czasu, zamiast dwukropków, więc zrozumiałem, że to jest istotne. Jeśli jednak chcesz mieć "prawdziwą" datę, to uzupełnij swój kod tak: [syntax=vbscript]Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Not Intersect(Target, Range("B1:C10")) Is Nothing...
Wklej w kod arkusza [syntax=vb]Dim tmp Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column = 2 Then Target.Offset(0, -1).Value = tmp End If End Sub Private Sub Worksheet_SelectionChange(ByVal Target As Range) tmp = Target.Value 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.
Jeśli ma być więcej takich samych list w tym samym arkuszu, to należy je skopiować ręcznie, a następnie użyć np. takiego makra (zamiast tego poprzedniego). Dodałem tu jeszcze zabezpieczenia przed błędami. [syntax=vbscript]Private Sub Worksheet_Change(ByVal Target As Range) Set Target = Intersect(Target, Range("D1, G3, J3")) If Target Is Nothing Then...
Kliknij prawym klawiszem myszki na zakładce arkusza, wybierz Wyświetl kod i w Edytorze VBA wklej Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column = 3 Then Target.Offset(0, 1) = Application.UserName End If End Sub Co robi to makro? Po każdej zmianie jaka następuje w kolumnie C (Target.Column = 3) wstawia w kolumnę...
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...
Mała poprawka: [syntax=vbscript]Private Sub Worksheet_Change(ByVal Target As Range) On Error Resume Next If Target.Column = 11 Then Dim ar() As String q = 0 a = Split(Target, " ") For aa = 0 To UBound(a) For x = 5 To 13 If Cells(x, 4) = a(aa) Then For Z = 5 To 9 If Cells(x, Z) = "X" Then c = Cells(4, Z) If InStr(1, b, c) = 0 Then ReDim Preserve ar(q)...
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=vb]Private Sub Worksheet_SelectionChange(ByVal Target As Range) if Intersect(Target, Range("AV4:BZ98")) Is Nothing Then Exit Sub Range("AR2") = ActiveCell.Column - 44 + Cells(ActiveCell.Row, 46) Range("AS2") = Cells(ActiveCell.Row, 45) Graf.Show End Sub [/syntax]
Można również połączyć zakresy komórek i wówczas kod jest następujący:[syntax=vb] Dim AktywneWiersze As Range Private Sub Worksheet_SelectionChange(ByVal Target As Range) Set AktywneWiersze = Union(Range("D13:BI35"), Range("D38:BI108"), Range("D111:BI133")) If Not Intersect(Target, AktywneWiersze) Is Nothing Then ActiveWorkbook.Names("AktywnyWiersz1").R...
Spróbuj z arkuszem z załącznika (podmień kod)[syntax=vb]Private Sub Worksheet_Change(ByVal Target As Range) Application.EnableEvents = False On Error Resume Next 'gdybyś czyścił zakres If Not Intersect(Target, Range("B1:B29")) Is Nothing Then Target.Value = Replace(Target.Value, " ", Chr(10)) ElseIf Target.Column = 1 Then wrs = (Target.Value * 2) -...
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...
Podpowiedź numer 2: [syntax=vbscript]Private Sub Worksheet_Change(ByVal Target As Range) [/syntax]
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 <=...
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...
Witam, Można użyć prostego makro - tylko nie wiem, czy o takie coś chodzi koledze: [syntax=vb]Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) Dim x As String If Target.Value = "" Then Exit Sub x = Replace(Target.Value, " ", "*") If Left(x, 1) <> "*" Then x = "*" + x If Right(x, 1) <> "*" Then x = x + "*" Target.Value...
Ile jeszcze będzie tych wariantów? Jeśli adresy list są różne, to najrozsądniej, jak myślę nadać im takie same nazwy i te nazwy wykorzystać do identyfikacji. Przykładowy kod: [syntax=vb]Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) Dim wks As Worksheet, nazwa As String If Target.Count > 1 Then Exit Sub If Intersect(Target,...
:arrow: fascynat Rzeczywiście, nieładnie się zachowałem, nie mój pomysł a się wtrąciłem. Przepraszam, spróbuje się w przyszłości poprawić. ;) Rozwinę więc swoją propozycję z wymuszeniem wciśnięcia insertu po podwójnym kliknięciu w komórkę z kropkami (np. w środek kropek). Nastąpi wtedy zastępowanie kropek tekstem. kod: Private Sub Worksheet_BeforeDoubleClick(ByVal...
Witam, Proponuję modyfikację kodu np taką :D : [syntax=vbscript]Private Sub Worksheet_Change(ByVal Target As Range) Application.EnableEvents = False If Target.Column = 1 Then Target.Offset(, 1) = Time End If If Target.Column = 3 Then Target.Offset(, 1) = Time End If With Sheets("Arkusz1") For Each obszar In .Range("a1:a" & Target.Row) If obszar.Value...
[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,...
Należy oprogramować zdarzenie SheetChange skoroszytu. Wykrywa ono równocześnie, w którym arkuszu i w której komórce nastąpiła zmiana. Kod: [syntax=text]Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) If Target.Address <> "$F$6" Then Exit Sub If IsNumeric(Target) And Target > 0 Then Sh.Tab.Color = vbRed Else Sh.Tab.Color...
Spróbuj procedury zdarzeniowej. Np [syntax=vb]Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Not Intersect(Target, Range("K5:K13")) Is Nothing And Target.Count = 1 Then For Each kom In Range("B3:F7") If kom.Value = Target.Value Then kom.Font.Bold = True Else kom.Font.Bold = False End If Next End If End Sub[/syntax]Wklej w kod arkusza,...
Pierwszą część możesz wygodnie zrealizować przy pomocy procedury zdarzeniowej, gdzie warunkiem jest zaznaczenie minimalnej ilości komórek (można ograniczyć do zakresu, kolumn, etc). Przykład dla zaznaczenia >3[syntax=vb]Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.Count > 3 Then For Each kom In Target If kom.Row / 2 =...
target codesys field target margin target
odbiornik janeczek schemat zasilacz antenowy korad ka3005 wentylator
Gaśnięcie silnika na wolnych obrotach - przyczyny i rozwiązania Instrukcje wprowadzania kodu do radia Clarion PU-7915