Witam,
Jestem w trakcie przygotowywania programu, który zwiększy efektywność i oszczędzi troszkę czasu. W związku z tym przygotowałem formularz, który dodaje nowe wiersze na podstawie istniejącego już numeru seryjnego.
Po dodaniu wierszy otrzymuje sytuację na jak na załączonym zdjęciu czyli wiersz numer 1 to jest mój główny wiersz, na podstawie którego zostały stworzone dodatkowe cztery. Dodatkowych wierszy może być różna liczba, ale zawsze kolumna nr 2 będzie taka sama dla danego numery seryjnego. Może również dojść do sytuacji, gdzie nie będzie dodatkowych wierszy, a będzie tylko ten jeden główny.
Numer seryjny to jest unikatowy numer, na podstawie którego pracujemy. Mam już napisany kod, który zmienia status w kolumnie 10 czyli "Status" oraz dodaje informacje w innych kolumnach, ale nie potrafię zapętlić tak tego kodu, aby ten sam status pojawiał się w innych wierszach dla tego samego numeru seryjnego jeśli taki istnieje. Poniżej mój kod. Bardzo proszę o wsparcie i podpowiedzi ?
Sub Update()
Dim sh As Worksheet
Dim iRow As Long
Dim OutApp As Object, adresaci, sciezka$, att$
Dim OutMail As Object
Dim OutAppTSR As Object, TSR, sciezka2$, att2$
Dim OutMailTSR As Object
Dim mfgType As String
Dim TSRname As String
Dim TSRnumber As String
Dim TSRemail As String
Dim MFGStatus As String
Dim regDtm As String
Dim i As Long
'Worksheets("Database").Unprotect Password:="LabABCD"
With ThisWorkbook.Worksheets("email")
adresaci = .Range("A1:A" & .Cells(.Rows.Count, 1).End(xlUp).Row)
End With
If IsArray(adresaci) Then adresaci = Join(WorksheetFunction.Transpose(adresaci), "; ")
With ThisWorkbook.Worksheets("email")
TSR = .Range("B1:B" & .Cells(.Rows.Count, 1).End(xlUp).Row)
End With
If IsArray(TSR) Then TSR = Join(WorksheetFunction.Transpose(TSR), "; ")
Set sh = ThisWorkbook.Sheets("Database")
ThisWorkbook.Sheets("Database").Activate
sh.Range("B1").Activate
Cells.Find(What:=mapFORM.txtRollNo, After:=ActiveCell, LookIn:=xlValues, SearchOrder:=xlByRows).Activate
iRow = ActiveCell.Row
mfgType = Cells(iRow, 6)
MFGStatus = Cells(iRow, 10)
TSRname = Cells(iRow, 17)
TSRnumber = Cells(iRow, 18)
With sh
.Cells(iRow, 6) = mapFORM.ComboBox4
.Cells(iRow, 7) = mapFORM.txtSample
.Cells(iRow, 10) = mapFORM.cmbStatus
If MFGStatus = "Niezarejestrowana" Then
If mapFORM.cmbStatus = "Zwolnione" Or mapFORM.cmbStatus = "Zamkniete" Or mapFORM.cmbStatus = "Decyzja" Or mapFORM.cmbStatus = "Retest" Or mapFORM.cmbStatus = "Odrzucone" Then
If regDtm = "" Then
MsgBox ("Zlecenie MFG nie zostalo jeszcze zarejestrowane w laboratorium i nie mozna go zwolnic. Najpierw zarejestruj material ze statusem Otwarte.")
Exit Sub
End If
Else: mapFORM.cmbStatus = "Otwarte"
.Cells(iRow, 8) = [Text(Now(), "MM/DD/YYYY HH:MM")]
.Cells(iRow, 10) = mapFORM.cmbStatus
.Cells(iRow, 11) = mapFORM.cbApprover
End If
Else
.Cells(iRow, 10) = mapFORM.cmbStatus
.Cells(iRow, 12) = [Text(Now(), "MM/DD/YYYY HH:MM")]
.Cells(iRow, 13) = mapFORM.cbApprover
End If
.Cells(iRow, 14).Value = Application.WorksheetFunction.IsoWeekNum(.Cells(iRow, 8).Value)
.Cells(iRow, 15) = mapFORM.ComboBox1
.Cells(iRow, 16) = mapFORM.txtComment
If Cells(iRow, 19) = "" Then
If mapFORM.cmbStatus = "Retest" Then
.Cells(iRow, 19) = "TAK"
.Cells(iRow, 20) = mapFORM.cbRetest1
.Cells(iRow, 21) = mapFORM.cbRetest2
.Cells(iRow, 22) = mapFORM.cbRetest3
Else: .Cells(iRow, 19) = "NIE"
End If
End If
End With
End Sub |