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...
Myślałem, że Pan odkładanie z powrotem swój kod [syntax=vb] Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean) 'Step 1: Declare Variables Dim strRange As String 'Step2: Build the range string strRange = Target.Cells.Address & "," & _ Target.Cells.EntireColumn.Address & "," & _ Target.Cells.EntireRow.Address...
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]Target = Target & Now[/syntax]
[syntax=vbscript]Private Sub Worksheet_Change(ByVal Target As Range) If Target = "" Then Exit Sub[/syntax]
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...
[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.Column = 3 Then Cells(Target.Row + 1, 1).Select End Sub [/syntax]
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]
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")...
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]
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]
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) -...
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]
Podmień Target na ActiveCell (to nie jest już procedura zdarzeniowa)...
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).
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,...
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]
Wklej w Thisworkbook [syntax=vb]Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) If Sh.Index > 7 Then If Target.Address(0, 0) = "A1" And Target.Value <> "" Then Sh.Name = Target.Value End If End If End Sub[/syntax] Lub takie, z zabezpieczeniem przed powtórzeniem nazwy[syntax=vb]Private Sub Workbook_SheetChange(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...
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=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]
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...
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]
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=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]
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]
[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...
Ż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")...
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]
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]
Tak, Np ActiveCell.FormulaArray = "=SUM(A1:A5)" Wracając do makra. Jeśli wypełniasz "od końca" to zmień warunek Target.Column na 8... Edit: Jeśli robie to chaotycznie to zmień i uzupełnij warunki [syntax=vb] ofs = IIf(Target.Column = 8, 1, -1) If Target.Column = 8 Or Target.Column = 9 And Target.Value <> Empty And _ Target.Offset(0,...
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ę...
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...
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...
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,...
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,...
[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?
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...
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
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.
If Target.Column > 2 Then Exit Sub If Target <> 0 Then Target.Offset(, 1 + Target.Column ) = Target.Offset(, 1 + Target.Column ) + Target
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....
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...
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]
Proszę[syntax=vb]Dim komTmp As String Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Not Intersect(Target, Range("A1:B4")) Is Nothing Then Application.EnableEvents = False If komTmp = "" Then komTmp = Target.Address If Range(komTmp) = Empty Then Range(komTmp).Select Else komTmp = Target.Address End If Application.EnableEvents = True...
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...
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]
Można pokombinować z funkcją WYBIERZ a godzinę wstawiać kombinacją Ctrl+Shift+":" Prościej (wygodniej) jednak będzie wykorzystać VBA. Wklej w kod arkusza, wypróbuj i dostosuj do własnych potrzeb Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column = 1 And Target.Count = 1 Then Target.Offset(0, 2) = Format(Time(),...
otwiera się Arkusz 2 zaznaczając pustą komórkę kolumny B (ewentualnie dodaje nowy pusty wiersz) Patrząc na załączony plik nie mogę zrozumieć w jakim celu chcesz zrobić to makro :?: :cry: Jeśli chcesz szybko weryfikować odniesienia do arkusza 2 to najprościej proponuję makro w arkuszu 1 :spoko: : [syntax=vbscript]Private Sub Worksheet_BeforeDoubleClick(ByVal...
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=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]
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...
[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 =...
[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,...
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...
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...
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...
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]
Jeżeli w komórce ma się "pojawić" napis "Nie dotyczy" a w innym przypadku masz wprowadzać datę to tak jak sam napisałeś w pierwszym poście: tylko proste makro to załatwi. Niestety funkcja jeżeli w tym przypadku to za mało. Kłopot polega że nie masz pojęcia o makrach (jak sam mówisz), a makro trzeba ustawić w "modułach zdarzeniowych" arkusza. Np. takie:...
[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]
[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,...
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]
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...
Witam, mam w skoroszycie zestawienia moich godzin pracy. Co pewien czas (miesiąc) eksportuję jeden skoroszyt danego miesiąca do pliku *.xls, który jest pozbawiony kodów VBA oraz funkcji i formatów komórek, czyli jest w postaci "strawnej" dla Androida. W związku z tym mam pytanie: Czy można jednorazowo wyłączyć (lub ominąć jednorazowo) w momencie wykonywania...
[syntax=vbscript]Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Target.Column = 1 Then Application.Cursor = xlWait x = Target.Row a = Cells(x, "A") & "-" & Cells(x, "C") & "-" & Cells(x, "F") & "-" & Cells(x, "I") & "-" & Cells(x, "J") Set w = CreateObject("Word.Application") Set d = w.Documents.Add w.Visible =...
Skoro Kolega chce VBA, to proszę. Kod dla modułu 'Arkusz3': [syntax=vb]Private Sub Worksheet_Change(ByVal Target As Range) If Target.Row = 2 And Target.Column = 2 Then If Target.Cells = "XYZ" Then Call Kopiuj End If End Sub[/syntax] Kod modułu skoroszytu: [syntax=vb]Sub Kopiuj() s = Sheets("Arkusz3").Range("B2") Sheets("Arkusz1").Select ow = Cells(Rows.Count,...
Najlepiej zrealizować to w procedurze zdarzeniowej przy zmianie. Ograniczać zakres już umiesz ;) If Not Intersect(Target, Range...
[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]
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
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...
[syntax=vbscript]Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column = 15 Then r = Target.Row Dim n As Worksheet Set n = Sheets("Nieprawidlowosci") ow = Cells(Rows.Count, "A").End(xlUp).Row nw = n.Cells(Rows.Count, "B").End(xlUp).Row + 1 If nw < 4 Then nw = 4 If UCase(Cells(r, 15)) = "TAK" Then If Application.CountIf(n.Range("D:D"),...
Jest prosty sposób na uruchomienie makra jeśli aktywowana będzie określona komórka. Powiedzmy, że zmieniasz dane w A1. Jeżeli posługujesz się klawiaturą to następna aktywowana komórka będzie A2 lub B1. Przykład uruchomienia makra dla B1 Private Sub Worksheet_SelectionChange(ByVal Target As Range) wiersz = 1 kolumna = 2 If Target.Row = wiersz...
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...
Dla modułu arkusza, gdzie jest 'Tabela1' użyj: [syntax=vbscript]Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.Column = 1 And Target.Row > 1 Then Call zamówienie End Sub [/syntax] P.S. Adamas_nt masz lepszy pomysł? Autor wątku jest skromny w wyjaśnieniach jego kłopotu... Chce, aby macro dzieło się, warunkiem musi być zmiana "numeru...
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]
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...
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...
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...
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...
[syntax=vbscript]Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Target.Column = 1 Then w = Target.Row ok = Cells(w, Columns.Count).End(xlToLeft).Column nw = Cells(Rows.Count, "A").End(xlUp).Row + 1 Range(Cells(w, 1), Cells(w, ok)).Copy Destination:=Range("A" & nw) Cancel = True End If 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.
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 [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]
Poniżej rozwiązanie z wykorzystaniem VBA Kliknij prawym przyciskiem na nazwie arkusza, z menu kontekstowego wybierz "wyświetl kod". W edytorze VBA wpisz: Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$A$1" Then If Target.Value = "x" Then Range("C1") = Range("B1") Else Range("C1") = "" End If End If End Sub Zapisz plik w formacie...
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)...
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...
[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...
Podpowiedź numer 2: [syntax=vbscript]Private Sub Worksheet_Change(ByVal Target As Range) [/syntax]
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...
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...
: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...
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)...
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.
target margin target systemu field target
manta led2206 matryca polowy schemat prostownika spawarki
VW Start-Stop Restriction: Słabe Napięcie - Co Zrobić? Schemat chińskiej przetwornicy 3000W do grzania wody
