Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address(False, False) = "A1" Then
If Range("A1").Value = 1 Then
Range("B1").Value = Range("B1").Value + 1
End If
End If
End Sub
--
Stanislaw
End Sub
Witam.
Tez mnie zainteresowal ten kod. Dziala fajnie gdy zmieniamy wpis w
komórce A1. Ale jak zrobic by dzialalo to równiez gdy w komórce A1 jest
formula np: =E1+E2 i dokonujemy zmian w komórkach E1, E2 w wyniku czego
w komórce A1 jest 0 lub 1.
Pozdrawiam
--
Edward Zadorski
Uzytkownik "Junga" <jungaW...@wp.pl> napisal w wiadomosci
news:ditiv9$t90$1...@atlantis.news.tpi.pl...
Np:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address(False, False) = "E1" Or _
Target.Address(False, False) = "E2" Then
Range("B1").Value = Range("B1").Value + _
Range("A1").Value
End If
End Sub
Tajan
> Private Sub Worksheet_Change(ByVal Target As Range)
>
> If Target.Address(False, False) = "E1" Or _
> Target.Address(False, False) = "E2" Then
>
> Range("B1").Value = Range("B1").Value + _
> Range("A1").Value
>
> End If
>
> End Sub
Dzięki. Chodzi mi jednak o jakieś rozwiązanie gdy formuła w komórce A1
jest bardzo skomplikowana i odwołuje się np do 90 innych komórek, a
niektóre z nich zmieniają wartość również na podstawie formuł.
EZ
> Dzięki. Chodzi mi jednak o jakieś rozwiązanie gdy formuła w komórce A1
> jest bardzo skomplikowana i odwołuje się np do 90 innych komórek, a
> niektóre z nich zmieniają wartość również na podstawie formuł.
>
W takim przypadku nalezy wykorzystać zdarzenie Worksheets.Calculate.
Dodatkowo nalezy uzyć pomocniczej komórki, aby wychwycić zmianę wartości w
A1, przechowując tam poprzednią wartośc tej komórki. Przykładowo:
Private Sub Worksheet_Calculate()
Application.EnableEvents = False
If Range("A1").Value <> Range("B2").Value Then
Range("B1").Value = Range("B1").Value + _
Range("A1").Value
Range("B2").Value = Range("A1").Value
End If
Application.EnableEvents = True
End Sub
W tym kodzie, jako pomocniczej, uzyłem komórki B2.
Tajan
> Private Sub Worksheet_Calculate()
>
> Application.EnableEvents = False
> If Range("A1").Value <> Range("B2").Value Then
> Range("B1").Value = Range("B1").Value + _
> Range("A1").Value
> Range("B2").Value = Range("A1").Value
> End If
> Application.EnableEvents = True
>
> End Sub
>
> W tym kodzie, jako pomocniczej, uzyłem komórki B2.
Dziękuję. Wprawdzie w Twoim kodzie wartość komórki B1 się nie zmieni, w
szczególnym przypadku, gdy w wyniku różnych działań wartość komórki A1=1
i będzie taka sama jak przed przeliczeniem (również A1=1). Z tym sobie
już poradzę.
Jeszcze raz dziękuję.
EZ
Użytkownik "Junga" <jungaW...@wp.pl> napisał w wiadomości
news:dits96$7fp$1...@atlantis.news.tpi.pl...
Oczywiscie, masz rację, ale to był tylko prosty przykład. Nic nie stoi na
przeszkodzie, aby w podobny sposób jak w przypadku komórki A1, śledzić
również wartości innych komórek.
Tajan
Jeszcze przykład dla zainteresowanych.
Private Sub Worksheet_Calculate()
Application.EnableEvents = False
If Range("E1").Value <> Range("B2").Value Or _
Range("E2").Value <> Range("B3").Value Then
Range("B1").Value = Range("B1").Value + _
Range("A1").Value
Range("B2").Value = Range("E1").Value
Range("B3").Value = Range("E2").Value
End If
Application.EnableEvents = True
End Sub
Śledzimy tutaj wartość komórek E1 i E2, używając do tego celu komórek
pomocniczych B2 i B3. Jeżeli w E1 lub E2 nastąpi zmiana wartosci, to
powiększamy wartość komórki B1 o wartość komórki A1.
Tajan
Private Sub Worksheet_Calculate()
Application.EnableEvents = False
Range("B1").Value = Range("B1").Value + _
Range("A1").Value
Application.EnableEvents = True
End Sub
ale jest problem bo ja mam kilkaset komorek (A1,A2,A3,A4 .... itd.) i
nie jestem w stanie do kazdej pisac ten kod. Nie mozna to w jakis inny
sposob to zrobic?
>
> ale jest problem bo ja mam kilkaset komorek (A1,A2,A3,A4 .... itd.) i
> nie jestem w stanie do kazdej pisac ten kod. Nie mozna to w jakis inny
> sposob to zrobic?
A co powoduje zmiane wartosci w tch komórkach (rozumiem, ze masz tam
formuly) i jak czesto ?
Tajan
> Tez mnie zainteresowal ten kod. Dziala fajnie gdy zmieniamy wpis w
> komórce A1. Ale jak zrobic by dzialalo to równiez gdy w komórce A1 jest
> formula np: =E1+E2 i dokonujemy zmian w komórkach E1, E2 w wyniku czego
> w komórce A1 jest 0 lub 1.
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Application.Intersect(Target, Me.Range("a1").Precedents) Is Nothing
Then
Range("b1") = Range("b1") + 1
End If
End Sub
Jeśli komórka A1 może byc uzalezniona od innych komórek w innych arkuszach
należałoby skorzystać ze zdarzenia WorksheetChange obiektu Workbook w module
ThisWorkbook.
Innym sposobem może być śledzenie wartości komórki A1 po każdej zmianie w
arkuszu i porównywanie jej z aktualną wartością. Wartośc komórki A1 możesz
przechowywać np. w rejestrze, w komórce w innym arkuszu (na przykład "bardzo
ukrytym") lub w postaci zmiennej (w tym przypadku konieczne jest
skorzystanie ze zdarzenia Workbook_Open celem przypisania zmiennej wartosci
początkowej.
--
Pozdrowienia
pxd74
> If Not Application.Intersect(Target, Me.Range("a1").Precedents) Is
> Nothing
> Then
Mógłbyś objaśnić mi ten zapis.
EZ
napisał:divt3f$37v$1...@nemesis.news.tpi.pl...
> > If Not Application.Intersect(Target, Me.Range("a1").Precedents) Is
> > Nothing
> > Then
>
> Mógłbyś objaśnić mi ten zapis.
Application.Intersect(zakres1, zakres2) to obiekt Range składający się z
częsci wspólnej zakresu1 i zakresu2. Jeśli nie ma częsci wpólmej to
zwaracana wartośc Nothing. Dlatego sprawdzane jest czy cześć wspólna nie
równa się Nothing (Is Nothing).
Target to obiekt Range składający się z komórki lub komórek, które się
zmieniły powodując wywołanie zdarzenia Change.
Me. Range("a1") to komórka A1 znajdująca się w arkuszu, w którego module
znajduje się ten kod. Słowo kluczowe Me zawsze oznacza obiekt, w którego
module znajduje się kod zawierający to słowo kluczowe.
Właściwość Precedents obiektu Range to poprzedniki czyli zbiór komórek, do
których wartości zależy wartość komórki (w tym przypadku komórki A1). Możesz
sobie zobaczyć te komórki wybierając w Excelu polecenie menu Narzędzia ->
Inspekcja -> Śledź poprzedniki. Możesz użyć też właściwości
DirectPrecedents - zwraca ona bezpośrednie poprzedniki, czyli komórki,
których odwołania znajdują się w formule komórki. Zbiór Precedents będzie
zawsze większy lub przynajmniej równy zbiorowi DeirectPrecedents. Obydwa te
zbiory to obiekty typu Range.
Reasumując powyższy zapis oznacza, że jeżeli jedną z komórek zmienianych
jest przednikiem komórki A1, to ma wykonać kod znajdujący się poniżej.
--
Pozdrowienia
pxd74
Tajan
Na przyklad w kazdej komorce od A1 do A1000 mam formuly ktore powoduja
ze sie zmieniaja na 1 albo 0 a oczywiscie na podstawie tych zmian sie
dodaja te jedynki do komorek B1 do B1000. Musialbym napisac do kazdej
komorki kod zeby w wszystkie mi sie zmienialo czyli:
Range("B1").Value = Range("B1").Value + _
Range("A1").Value
Range("B2").Value = Range("B2").Value + _
Range("A2").Value
Range("B3").Value = Range("B3").Value + _
Range("A3").Value
Range("B4").Value = Range("B4").Value + _
Range("A4").Value
Range("B5").Value = Range("B5").Value + _
Range("A5").Value
................. i tak dalej. Czy można tego w jakis inny sposob
zrobic zeby nie pisac tyle tego kodu? Na innym forum dostalem ciekawe
rozwiazanie w ktorym wystarczylo wpisac ten kod:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 1 Then
If Target.Value = 1 Then
Target.Offset(0, 1).Value = _
Target.Offset(0, 1).Value + 1
End If
End If
End Sub
..i mi sumowalo w wszystkie komorki tylko niestety to nie dziala jak w
komorkach A mam formule.
Dziękuję za wyjaśnienie.
Dzięki forum znowu dowiedziałem się czegoś nowego.
Przy okazji. Czy znajdę gdzieś opis wszystkich metod i właściwości
obiektów (po polsku)?
Pozdrawiam
--
Edward Zadorski
> Private Sub Worksheet_Change(ByVal Target As Range)
>
> If Target.Column = 1 Then
> If Target.Value = 1 Then
> Target.Offset(0, 1).Value = _
> Target.Offset(0, 1).Value + 1
> End If
> End If
>
> End Sub
>
> ..i mi sumowalo w wszystkie komorki tylko niestety to nie dziala jak w
> komorkach A mam formule.
Spróbuj tego:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
Dim dep As Range
Dim i As Long
On Error Resume Next
Set dep = Target.Dependents
On Error GoTo 0
If Not dep Is Nothing Then
If Not Application.Intersect(dep, Me.Columns(1)) Is Nothing Then
Set rng = Application.Intersect(dep, Me.Columns(1))
For i = 1 To rng.Count
rng(i).Offset(0, 1) = rng(i).Offset(0, 1) + 1
Next
End If
End If
End Sub
Mam tylko nadzieje, że komórki z kolumny A nie zależą od komórek w kolumnie
B ani od komórek w innych arkuszach.
--
Pozdrowienia
pxd74
> Przy okazji. Czy znajdę gdzieś opis wszystkich metod i właściwości
> obiektów (po polsku)?
Kiedyś na stronce www.vba.matrix.pl był cześciowy opis metod i właściwości
po polsku. Ja jednak proponuję Ci poczytać po angielsku w helpie - zawsze
ten opsi jest pełniejszy i wraz z przykładami. Nie jest to aż takie trudne
do skumania jeśli zna się tylko podstawy angielskiego.
--
Pozdrowienia
pxd74
Odnalazłem częściową zawartość Matrixa pod adresem
http://informatyka.2lo.pl/edukacja/vba/
--
Stanislaw
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
Dim dep As Range
Dim i As Long
On Error Resume Next
Set dep = Target.Dependents
On Error GoTo 0
If Not dep Is Nothing Then
If Not Application.Intersect(dep, Me.Columns(1)) Is Nothing Then
Set rng = Application.Intersect(dep, Me.Columns(1))
For i = 1 To rng.Count
if rng(i) = 1 then
rng(i).Offset(0, 1) = rng(i).Offset(0, 1) + 1
end if
Next
End If
End If
End Sub
Nie jestem tylko pewien czy o to chodzilo. Jesli nie to wypróbuj jeszcze to:
- w module arkusza:
Public arr As Variant
Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Long
Application.EnableEvents = False
For i = 1 To Me.UsedRange.Rows.Count
If i > UBound(arr) Then
Me.Cells(i, 2) = Me.Cells(i, 2) + 1
ElseIf Me.Cells(i, 1) <> arr(i) Then
Me.Cells(i, 2) = Me.Cells(i, 2) + 1
End If
Next
Application.EnableEvents = True
arr = Application.Transpose(Me.Range("A1:A" &
Me.UsedRange.Rows.Count).Value)
End Sub
- poza tym w module skoroszytu (ThisWorkbook)
Private Sub Workbook_Open()
With Me.Worksheets("Arkusz1")
.arr = Application.Transpose(.Range("a1:A" &
.UsedRange.Rows.Count).Value)
End With
End Sub
--
Pozdrowienia
pxd74
W tym drugim przypadku najpierw zamknij skoroszyt i otwórz go ponownie -
wtedy nie powinno byc bledów, jesli beda to napisz dokladnie jaki i na
jakiej linii. Przenies caly kod z drugiego przykladu do zdarzenia Calculate
i powinno byc OK.
--
Pozdrowienia
pxd74
Public arr As Variant
Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Long
Application.EnableEvents = False
For i = 1 To Me.UsedRange.Rows.Count
If i > UBound(arr) Then
Me.Cells(i, 2) = Me.Cells(i, 2) + 1
ElseIf Me.Cells(i, 1) <> arr(i) Then
Me.Cells(i, 2) = Me.Cells(i, 2) + 1
End If
Next
Application.EnableEvents = True
arr = Application.Transpose(Me.Range("A1:A" &
Me.UsedRange.Rows.Count).Value)
End Sub
w module ThisWorkbook:
Private Sub Workbook_Open()
With Me.Worksheets("Arkusz1")
.arr = Application.Transpose(.Range("a1:A" &
.UsedRange.Rows.Count).Value)
End With
End Sub
no i mi wyskakuje blad Run-time error '13' Type mismatch i mi zaznacza
na zolto w Arkuszu1 If i > UBound(arr) Then
> no i mi wyskakuje blad Run-time error '13' Type mismatch i mi zaznacza
> na zolto w Arkuszu1 If i > UBound(arr) Then
A czy zamknales skoroszyt i ponownie go otworzyles?
--
Pozdrowienia
pxd74
Ale zakladalem, ze arkusz bedzie juz wypelnionymi jakimis danymi, to znaczy
przynajmniej w dwóch wierszach. Jesli jednak nie, to zmien kod na
nastepujacy:
Private Sub Worksheet_Calculate()
Dim i As Long
Application.EnableEvents = False
For i = 1 To Me.UsedRange.Rows.Count
If IsArray(arr) Then
If i > UBound(arr) Then
Me.Cells(i, 2) = Me.Cells(i, 2) + 1
ElseIf Me.Cells(i, 1) <> arr(i) Then
Me.Cells(i, 2) = Me.Cells(i, 2) + 1
End If
Else
If Me.Cells(i, 1) <> arr Or i > 1 Then
Me.Cells(i, 2) = Me.Cells(i, 2) + 1
End If
End If
Next
Application.EnableEvents = True
arr = Application.Transpose(Me.Range("A1:A" &
Me.UsedRange.Rows.Count).Value)
End Sub
Zmienilem juz zdarzenie na Calculate. Musisz wiedziec o tym, ze zdarzenie
Calculate nie bedzie generowane, gdy zmieni sie wartosc komórki nie
powiazanej z innymi komórkami poprzez formuly. Mozesz wykorzystac wtedy
zarówno zdarzenie Change jak i Calculate.
--
Pozdrowienia
pxd74
Zdaje się, że od początku Ciebie nie rozumiałem. Myślałem, że chcesz śledzić
zmiany wartości w kolumnie A. Po przejrzeniu jeszcze raz wszystkich postów
napisałem coś takiego (nie musisz ponownie otwierać skoroszytu)
Private Sub Worksheet_Calculate()
Dim i As Long
Application.EnableEvents = False
For i = 1 To Me.UsedRange.Rows.Count
If Me.Cells(i, 1) = 1 Then
Me.Cells(i, 2) = Me.Cells(i, 2) + 1
End If
Next
Application.EnableEvents = True
End Sub
Jak to też nie bedzie spełniać Twoich oczekiwań, to napisz nieco dokładniej
o co chodzi z tymi jedynkami- może jakiś przykład.
--
Pozdrowienia
pxd74
Private Sub Worksheet_Calculate()
Dim i As Long
Application.EnableEvents = False
For i = 1 To Me.UsedRange.Rows.Count
If IsArray(arr) Then
If i > UBound(arr) Then
Me.Cells(i, 2) = Me.Cells(i, 2) + 1
ElseIf Me.Cells(i, 1) <> arr(i) Then
Me.Cells(i, 2) = Me.Cells(i, 2) + 1
End If
Else
If Me.Cells(i, 1) <> arr Or i > 1 Then
Me.Cells(i, 2) = Me.Cells(i, 2) + 1
End If
End If
Next
Application.EnableEvents = True
arr = Application.Transpose(Me.Range("A1:A" &
Me.UsedRange.Rows.Count).Value)
End Sub
wywalilem Or i > 1 i zadzialalo, dzisiaj zostawie wlaczony excel zeby
przetestowac ale mysle ze juz wszystko bedzie ok.
Wielkie dzieki, bardzo mi pomogles :)
Pozdrawiam
Serwis www.vba.matrix.pl powstał w wyniku przeniesienia serwisu
www.vba.profit.pl na serwer firmy Matrix.pl z Warszawy zajmujacej sie
produkcja oprogramowania księgowego ( np. Symfonia)
Serwis ten przez klika lat napisałem od podstaw a później rozwijałem.
Aktualnie serwis nie istnieje, a o ewentualne jego dalsze losy należałoby
spytać firmę Matrix.pl
Serwis www.vba.matrix.pl jest własnościa firmy Matrix.pl,
wszelkie próby kopiowania w całości lub częsci jest naruszeniem praw
auorskich, których właścicielem jest firma Matrix.pl ( www.matrix.pl)
Pozdrawiam
Waldek
autor www.vba.profit.pl a póżniej www.vba.matrix.pl
email: vba (at) profit.pl