Excel Forum - Porady, Pomoc, Excel Help, Excel FAQ - Chyba Makro

marcin0005 · świeżak Posty: 1

Witam

Plik jest w załączniku, dla mnie to magia jestem humanistą :-)

Zapraszam ścisłe umysły do współpracy.

Pozdrawiam
Marcin

lista zamówień.rar
Wszystko opisane w załączniku

Pobierz Plik ściągnięto 18 raz(y) 11.16 KB

pitermxa · Starszy Forumowicz **Pomógł:** 7 razy Posty: 46

Mam nadzieje, ze efekt jest taki jaki miał być.
Jedna tylko uwaga. To makro można odpalić tylko raz.
Jeżeli odpali się go ponownie po pewnym czasie, to te wartości, które były dodane wcześniej zostaną zbublowane.
oczywiście można by było dopisac makro, które przed wykonaniem tego makra, kasuje wszystkie wartości, no ale to juz pozostawiam do zabawy Tobie, jeżeli w ogóle jest taka potrzeba.
Pozdrawiam.
PS skopuj ten kod do nowego modułu i przypisz makro do stworzonego przycisku:

Kod:

Sub makro()
Dim tablica() As Long
Dim i As Integer
Dim wiersz As Integer
Dim wiersze As Integer
Dim x As Integer
Dim y As Integer
Dim pierwszy As Integer
Dim ostatni As Integer
Dim h As Integer
Dim koniec As Integer
Dim pomoc As Boolean
Dim wier As Long
Dim g As Integer
Dim d As Integer
pomoc = False
y = 1
x = 0
g = 0
Sheets("stan komponentów na magazynie").Activate
Range("B2").Select
wiersze = ActiveCell.End(xlDown).Row

For d = 1 To wiersze
If IsNumeric(Sheets("zamówienia").Cells(i + 1, 1).Value) And Sheets("zamówienia").Cells(i + 1, 1).Value <> 0 And Sheets("zamówienia").Cells(i + 1, 1).Value <> "" Then
Else
x = x + 1
End If
Next d
wier = wiersze + x

For i = 1 To wier

If IsNumeric(Sheets("zamówienia").Cells(i + 1, 1).Value) And Sheets("zamówienia").Cells(i + 1, 1).Value <> 0 And Sheets("zamówienia").Cells(i + 1, 1).Value <> "" Then
Else
pierwszy = 0
ostatni = 0
g = 0
pomoc = False
Sheets("stan komponentów na magazynie").Activate
Cells(2, 3).Select
koniec = ActiveCell.End(xlDown).Offset(-1, 0).Row
For h = 1 To koniec
If Sheets("zamówienia").Cells(i + 1, 2).Value = Sheets("stan komponentów na magazynie").Cells(h + 1, 3).Value Then
If pomoc = False Then
pierwszy = Sheets("stan komponentów na magazynie").Cells(h + 1, 3).Row
End If
If pomoc = False Then pomoc = True
g = g + 1
End If
Next h
ostatni = pierwszy + g
Sheets("stan komponentów na magazynie").Activate
If pierwszy = 0 Then GoTo dalej
If ostatni = 0 Then GoTo dalej
Range(Cells(pierwszy, 1), Cells(ostatni - 1, 4)).Select
Selection.Copy
Sheets("zamówienia").Activate
Cells(i + 2, 1).Insert xlDown
dalej:
End If
Next i
Sheets("zamówienia").Activate

End Sub

nowy moduł -> alt + F11 a następnie ->
prawym przyciskiem kliknąć we wskazanym miescu i wybrać moduł
W załączniku obrazek jak to zrobić

Edit. Proszę stosować TAGI [CODE].

pic.jpg

Plik ściągnięto 5 raz(y) 131.47 KB