我有3个工人。 我需要进行流水线平衡。 有10个模型操作。 您可以在下表中查看所有工人的工作时间。他们有不同的能力。
因此,我需要在3名工作人员之间共享所有操作。
所以我需要什么: 模型的工作人员和操作可变。
20名工人25次手术
18个工作人员40次操作
19个工作人员-75次操作 ...
所以我需要为所有i定义参数。也许需要使用一个功能?
Sub rapor_calistir()
Range("q1") = Now()
Sheets("Rapor").Range("A2:Z1048576").ClearContents
a = 2: worker1 = 0: worker2 = 0: worker3 = 0
For i1 = 1 To 3
For i2 = 1 To 3
For i3 = 1 To 3
For i4 = 1 To 3
For i5 = 1 To 3
For i6 = 1 To 3
For i7 = 1 To 3
For i8 = 1 To 3
For i9 = 1 To 3
Sheets("Rapor").Cells(a, 1) = a - 1
Sheets("Rapor").Cells(a, 2) = i1
Sheets("Rapor").Cells(a, 3) = i2
Sheets("Rapor").Cells(a, 4) = i3
Sheets("Rapor").Cells(a, 5) = i4
Sheets("Rapor").Cells(a, 6) = i5
Sheets("Rapor").Cells(a, 7) = i6
Sheets("Rapor").Cells(a, 8) = i7
Sheets("Rapor").Cells(a, 9) = i8
Sheets("Rapor").Cells(a, 10) = i9
Sheets("Rapor").Cells(a, 11) = i10
For i = 1 To 10
ara_toplam = ara_toplam + WorksheetFunction.VLookup(i, Sheets("Data").Columns("A:D"), Sheets("Rapor").Cells(a, i + 1) + 1, False)
If Sheets("Rapor").Cells(a, i + 1) = 1 Then
worker1 = worker1 + WorksheetFunction.VLookup(i, Sheets("Data").Columns("A:D"), Sheets("Rapor").Cells(a, i + 1) + 1, False)
ElseIf Sheets("Rapor").Cells(a, i + 1) = 2 Then
worker2 = worker2 + WorksheetFunction.VLookup(i, Sheets("Data").Columns("A:D"), Sheets("Rapor").Cells(a, i + 1) + 1, False)
ElseIf Sheets("Rapor").Cells(a, i + 1) = 3 Then
worker3 = worker3 + WorksheetFunction.VLookup(i, Sheets("Data").Columns("A:D"), Sheets("Rapor").Cells(a, i + 1) + 1, False)
End If
Next i
Sheets("Rapor").Cells(a, 12) = ara_toplam
Sheets("Rapor").Cells(a, 13) = worker1
Sheets("Rapor").Cells(a, 14) = worker2
Sheets("Rapor").Cells(a, 15) = worker3
ara_toplam = 0: worker1 = 0: worker2 = 0: worker3 = 0
a = a + 1
Next i10
Next i9
Next i8
Next i7
Next i6
Next i5
Next i4
Next i3
Next i2
Next i1
End Sub
答案 0 :(得分:0)
这听起来像是一个组合问题(顺序无关紧要)。
Option Explicit
Sub main()
Call for_each_in_others(rDATA:=Worksheets("Sheet1").Range("A2"), bHDR:=True)
End Sub
Sub for_each_in_others(rDATA As Range, Optional bHDR As Boolean = False)
Dim v As Long, w As Long
Dim iINCROWS As Long, iMAXROWS As Long, sErrorRng As String
Dim vVALs As Variant, vTMPs As Variant, vCOLs As Variant
On Error GoTo bm_Safe_Exit
appTGGL bTGGL:=False
With rDATA.Parent
With rDATA(1).CurrentRegion
'Debug.Print rDATA(1).Row - .Cells(1).Row
With .Resize(.Rows.Count - (rDATA(1).Row - .Cells(1).Row), .Columns.Count).Offset(2, 0)
sErrorRng = .Address(0, 0)
vTMPs = .Value2
ReDim vCOLs(LBound(vTMPs, 2) To UBound(vTMPs, 2))
iMAXROWS = 1
'On Error GoTo bm_Output_Exceeded
For w = LBound(vTMPs, 2) To UBound(vTMPs, 2)
vCOLs(w) = Application.CountA(.Columns(w))
iMAXROWS = iMAXROWS * vCOLs(w)
Next w
'control excessive or no rows of output
If iMAXROWS > Rows.Count Then
GoTo bm_Output_Exceeded
ElseIf .Columns.Count = 1 Or iMAXROWS = 0 Then
GoTo bm_Nothing_To_Do
End If
On Error GoTo bm_Safe_Exit
ReDim vVALs(LBound(vTMPs, 1) To iMAXROWS, LBound(vTMPs, 2) To UBound(vTMPs, 2))
iINCROWS = 1
For w = LBound(vVALs, 2) To UBound(vVALs, 2)
iINCROWS = iINCROWS * vCOLs(w)
For v = LBound(vVALs, 1) To UBound(vVALs, 1)
vVALs(v, w) = vTMPs((Int(iINCROWS * ((v - 1) / UBound(vVALs, 1))) Mod vCOLs(w)) + 1, w)
Next v
Next w
End With
End With
.Cells(2, UBound(vVALs, 2) + 2).Resize(1, UBound(vVALs, 2) + 2).EntireColumn.Delete
If bHDR Then
rDATA.Cells(1, 1).Offset(-1, 0).Resize(1, UBound(vVALs, 2)).Copy _
Destination:=rDATA.Cells(1, UBound(vVALs, 2) + 2).Offset(-1, 0)
End If
rDATA.Cells(1, UBound(vVALs, 2) + 2).Resize(UBound(vVALs, 1), UBound(vVALs, 2)) = vVALs
End With
GoTo bm_Safe_Exit
bm_Nothing_To_Do:
MsgBox "There is not enough data in " & sErrorRng & " to perform expansion." & Chr(10) & _
"This could be due to a single column of values or one or more blank column(s) of values." & _
Chr(10) & Chr(10) & "There is nothing to expand.", vbInformation, _
"Single or No Column of Raw Data"
GoTo bm_Safe_Exit
bm_Output_Exceeded:
MsgBox "The number of expanded values created from " & sErrorRng & _
" (" & Format(iMAXROWS, "\> #, ##0") & " rows × " & UBound(vTMPs, 2) & _
" columns) exceeds the rows available (" & Format(Rows.Count, "#, ##0") & ") on this worksheet.", vbCritical, _
"Too Many Entries"
bm_Safe_Exit:
appTGGL
End Sub
Sub appTGGL(Optional bTGGL As Boolean = True)
Application.EnableEvents = bTGGL
Application.ScreenUpdating = bTGGL
End Sub
之前:
之后: