napisał: szymek
postów: 7
 umieszczony:
29 kwietnia 2007
21:34
|
|
Cześć to jeszcze raz Ja walczę z tym kodem ile się tylko da i wszystko jest ok., ale pojawił sie jeden problem i zaraz wytłumaczę, jaki.
Kolumny od A1:A50 i instrukcja if jest spoko natomist w kolumnie B1:B50 są zawarte informacje krtóre jak myślałem są stałe i instrukcja Case jest odpowiednia.Niestety w się trochę zagalopowałem i nie zauważyłem, że w pewnym momencie dane z kolumny A1:A50 mają też wpływ na instrukcje zawarte B1:B50, ale jest to pojedyńczy przypadek.
Sprawa wygląda tak, że w kolumnie pirwszej wpisuje wzory od D001 do D050 i do tych wzorów są przypisane dane wykonywane w kolumnie drugiej za pomocą instrukcji Select Case i są stałe tylko w trzech przypadkach są inne, czyli w D020,D021,D030 dane są takie: Select Case .Value
If Not Intersect(Target, Range("B1:B50")) Is Nothing Then
With Target
Select Case .Value
Case 36, 40
.Offset(RowOffset:=0, ColumnOffset:=5) = 1
Case 41
.Offset(RowOffset:=0, ColumnOffset:=5) = 2
Case 42 To 46
.Offset(RowOffset:=0, ColumnOffset:=5) = 3
Case Else
.Offset(RowOffset:=0, ColumnOffset:=5) = ""
End Select
End With
End If
Co do reszty to dam sobie radę, bo nie chciałem ci zawracać głowy danymi, które i tak ci nic nie mówią a ja przynajmniej czegoś się nauczę. |
|
|
napisał: szymek
postów: 7
umieszczony:
25 kwietnia 2007
20:14
|
|
Tak właśnie myślałem i nawet próbowałem to zrobić, ale ciągle miałem jakieś błędy, dlatego dziękuję za pomoc i dalej będę próbował sam z tym walczyć ewentualnie z użyciem twojej pomocy, jeżeli oczywiście nie nadużyje twojej cierpliwości.
Pozdro dla Rycha i wszystkich forumowiczów |
|
|
napisał: Rycho
postów: 291
umieszczony:
25 kwietnia 2007
13:37
 edytowany:
25 kwietnia 2007
13:39
|
|
Hej.
W makrze dodaj kolejną sekcję (po ostatnim End If), która to wykona:
If Not Intersect(Target, Range("B1:B50")) Is Nothing Then
With Target
Select Case .Value
Case 36, 37
'wpisz w kolumnie D
.Offset(RowOffset:=0, ColumnOffset:=2) = 1
Case 38, 39
.Offset(RowOffset:=0, ColumnOffset:=2) = 2
Case 40 To 46
.Offset(RowOffset:=0, ColumnOffset:=2) = 3
Case Else
.Offset(RowOffset:=0, ColumnOffset:=2) = ""
End Select
End With
End If
Powodzenia |
|
|
napisał: szymek
postów: 7
umieszczony:
24 kwietnia 2007
19:30
|
|
Przepraszam, co do ostatniego posta, ale jest tam niepełny kod i nic z niego nie wynika.
To jest brakująca część kodu Private Sub Worksheet_Change(ByVal Target As Range)
Const ZakresDziałania = "A1:A50" |
|
|
napisał: szymek
postów: 7
umieszczony:
23 kwietnia 2007
20:35
|
|
To jest to i nawet zaczynam rozumieć to trochę i nawet zmodyfikowałem, ale w głowie rodzą się kolejne pomysły, bo widzę, że możliwości jest wiele, więc pytam.
Jak stworzyć kolejną zmienną z kolumny od B1 do B50 w której będzie zakres liczb od 36 do 46 (tak jak w przypadku D0001 D0002) i kolejno każda z tych liczb będzie odpowiadała za wynik w komórce D1 do D50, który dotychczas wynosił D004 lub D005, ale jeżeli można to te dane zamieniłbym na?
Jeżeli w B1 wpiszę od 36 do 37 w D1 =1
Jeżeli w B1 wpiszę od 38 do 39 w D1 =2
Jeżeli w B1 wpiszę od 40 do 46 w D1 =3
Reszta pozostaje bez zmian, chociaż trochę dostosowałem do swoich potrzeb, ale twoja wersja i tak jest świetna i na pewno bardziej profesjonalna, ale Ja jestem jeszcze za "cienki"
Dim cNr As String
If Target.Cells.Count > 1 Then Exit Sub
On Error GoTo Works_Chang_Error
Application.EnableEvents = False
If Not Intersect(Target, Range(ZakresDziałania)) Is Nothing Then
With Target
If .Value = "D0001" Then '
' czyli B1 wpisz
.Offset(RowOffset:=0, ColumnOffset:=1) = "B004"
' 2 kolumny w prawo, czyli do C1 wpisz
.Offset(RowOffset:=0, ColumnOffset:=2) = "C004"
' 3 kolumny w prawo, czyli do D1 wpisz
.Offset(RowOffset:=0, ColumnOffset:=3) = "D004"
ElseIf .Value = "D0002" Then
' czyli B1 wpisz
.Offset(RowOffset:=0, ColumnOffset:=1) = "B005"
' 2 kolumny w prawo czyli do C1 wpisz
.Offset(RowOffset:=0, ColumnOffset:=2) = "C005"
' 3 kolumny w prawo czyli do D1 wpisz
.Offset(RowOffset:=0, ColumnOffset:=3) = "D005"
Else
.Offset(RowOffset:=0, ColumnOffset:=1).Resize(RowSize:=1, ColumnSize:=3) = ""
End If
End With
End If
Works_Chang_Exit:
On Error Resume Next
Application.EnableEvents = True
Exit Sub
Works_Chang_Error:
Resume Works_Chang_Exit
End Sub
Jeżeli uważasz że zwariowałem i cierpię na chroniczny brak zajęcia to nie musisz mi pomagać bo i tak wystarczająco mi pomogłeś za co jestem wdzięczny ale jeżeli masz ochotę trochę pokombinować to Ja będę bogatszy o wiedzę o VBA i moje życie będzie mniej skomplikowane. |
|
|
napisał: Rycho
postów: 291
umieszczony:
22 kwietnia 2007
20:50
|
|
Hej. Miło, że mogłem pomóc. :)
Makro uogólnione:
Private Sub Worksheet_Change(ByVal Target As Range)
Const ZakresDziałania = "A1:A50"
Dim cNr As String
If Target.Cells.Count > 1 Then Exit Sub
On Error GoTo Works_Chang_Error
Application.EnableEvents = False
If Not Intersect(Target, Range(ZakresDziałania)) Is Nothing Then
With Target
'dla liczb pasujących do wzorca - litera i 4 cyfry
If .Value Like "[A-Z]####" Then
'liczba do wpisania po literze
cNr = Format(CInt(Mid(.Value, 2)) + 3, "000")
.Offset(0, 1) = "B" & cNr ' 1 kolumna na prawo
.Offset(0, 2) = "C" & cNr
.Offset(0, 3) = "D" & cNr
Else
.Offset(0, 1).Resize(1, 3) = ""
End If
End With
End If
Works_Chang_Exit:
On Error Resume Next
Application.EnableEvents = True
Exit Sub
Works_Chang_Error:
Resume Works_Chang_Exit
End Sub
Pozdrawiam wzajemnie. |
|
|
napisał: szymek
postów: 7
umieszczony:
22 kwietnia 2007
19:56
|
|
Witam i jestem pod wrażeniem, bo na ogół zajmuje się grafiką i projektowaniem (branża erotyczna)
I nie jestem mocny z programowania, VBA ale ogromnie mnie wciągało i zamierzam dalej próbować tworzyć swoje aplikacje lub skrypty. Bez waszej pomocy raczej nie dałbym sobie rady, ponieważ myślę i tworzę perspektywicznie i jak widzę gotowy działający skrypt VBA łatwiej jest mi go zrozumieć.
Ogromne podziękowanie za rzetelną pomoc, bo poprzednie forum, z którego korzystałem nie potrafiło odpowiedzieć na moje pytanie i do tego zostałem potraktowany jak gość zawracający d...
Ale może to nawet dobrze, bo trafiłem do was  Korzystając z okazji waszej dobroci i profesjonalizmu chciałem jeszcze zapytać czy można zastosować ten skrypt dla kolejnych 50 wierszy i czy zrobić dopisując kolejno If .Address() = "$A$1" Or .Address() = "$A$2" Or .Address() = "$A$3" Or .Address() = "$A$5"Then ' i tak dalej aż do 50 czy można zastosować jakiś zakres tych wierszy np. od 1 do 50 i jak by to wyglądało.
Pozdro dla Rycha |
|
|
napisał: Rycho
postów: 291
umieszczony:
21 kwietnia 2007
21:47
|
|
Witaj.
A dlaczego nie zrobiłeś tega za pomocą prostych formuł?
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
On Error GoTo Works_Chang_Error
Application.EnableEvents = False
With Target
If .Address() = "$A$1" Or .Address() = "$A$2" Then '
If .Value = "D0001" Then '
' czyli B1 wpisz
.Offset(RowOffset:=0, ColumnOffset:=1) = "B004"
' 2 kolumny w prawo czyli do C1 wpisz
.Offset(RowOffset:=0, ColumnOffset:=2) = "C004"
' 3 kolumny w prawo czyli do C1 wpisz
.Offset(RowOffset:=0, ColumnOffset:=3) = "D004"
ElseIf .Value = "D0002" Then
' czyli B2 wpisz
.Offset(RowOffset:=0, ColumnOffset:=1) = "B005"
' 2 kolumny w prawo czyli do C2 wpisz
.Offset(RowOffset:=0, ColumnOffset:=2) = "C005"
' 3 kolumny w prawo czyli do C2 wpisz
.Offset(RowOffset:=0, ColumnOffset:=3) = "D005"
Else
.Offset(RowOffset:=0, ColumnOffset:=1).Resize(RowSize:=1, ColumnSize:=3) = ""
End If
End If
End With
Works_Chang_Exit:
On Error Resume Next
Application.EnableEvents = True
Exit Sub
Works_Chang_Error:
Resume Works_Chang_Exit
End Sub |
|
|
napisał: szymek
postów: 7
umieszczony:
19 kwietnia 2007
20:48
|
|
Witam forumowiczów i na wstępie chciałem dodać, iż cieszę sie, że są takie fora internetowe z nieograniczonym zakresem wiedzy. Mam taki mały problem; zawartym w kodzie klasy arkusza, ponieważ po wpisaniu w komórce A1 "D0001" w pozostałych komórkach tego samego wiersza automatycznie wstawia mi "B004" ; "C004"; "D004" i wszystko jest ok. tylko jak zmodyfikować ten kod żebym miał możliwość wyboru wpisania w komórce A1:
"D0001" (B004;C004;D004)-informacje w nawiasie są wstawiane automatycznie i w komórk. B1;C1;D1
lub
"D0002" (B005;C005;D005)-informacje w nawiasie są wstawiane automatycznie i w komórk. B1;C1;D1
Tą samą zależność chciałem zastosować do drugiego wiersza, czyli A2;B2;C2;D2
Poniżej jest kod, którego nie wiem jak zmodyfikować możecie go przetestować żeby lepiej mnie zrozumieć i jeżeli to wczymś pomoże to korzystam z MS Office 2002
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
On Error GoTo Works_Chang_Error
Application.EnableEvents = False
With Target
If .Address() = "$A$1" Then '
If .Value = "D0001" Then '
' czyli B1 wpisz
.Offset(RowOffset:=0, ColumnOffset:=1) = "B004"
' 2 kolumny w prawo czyli do C1 wpisz
.Offset(RowOffset:=0, ColumnOffset:=2) = "C004"
' 3 kolumny w prawo czyli do C1 wpisz
.Offset(RowOffset:=0, ColumnOffset:=3) = "D004"
Else
.Offset(RowOffset:=0, ColumnOffset:=1).Resize(RowSize:=1, ColumnSize:=3) = ""
End If
End If
End With
Works_Chang_Exit:
On Error Resume Next
Application.EnableEvents = True
Exit Sub
Works_Chang_Error:
Resume Works_Chang_Exit
End Sub
Z góry dziękuję za pomoc i pozdrawiam. |
|
|
 wstecz 1 dalej  wszystkich stron: 1
|
|
