truonghoai123
Thành viên mới
- Tham gia
- 10/9/18
- Bài viết
- 3
- Được thích
- 0
Mã:
Sub Test()
Dim sArr(), dArr(1 To 10000, 1 To 10000), i As Long, j As Long, k As Long, n As Long, x As Long, y As Long, z As Long
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
If ((ws.Name <> "BF") And (ws.Name <> "bfsmall") And (ws.Name <> "rvsamall") And (ws.Name <> "rev")) Then
sArr = ws.[A1].CurrentRegion.Offset(1).Value
For m = 2 To UBound(sArr, 1) - 1
If (ws.Cells(3, m).Value = "???????Mud cake of BF Dust") Then
With Sheets("BF")
For i = 1 To UBound(sArr, 1) - 1
k = k + 1
For j = 1 To UBound(sArr, 2)
dArr(k, j) = sArr(i, j)
Next j
Next i
.[A1:Z100000].ClearContents
If k Then .[A2].Resize(k, .[IV1].End(xlToLeft).Column).Value = dArr
End With
For y = 1 To 10000
With Sheets("bfsmall")
.[A1:Z1000].ClearContents
.[Bm] = ws.Cells(9, m).Value
.[Cm] = ws.Cells(10, m).Value
ws.Cells("y,1").Value = Mid(ws.Cells(4, m).Value, 1, 8)
End With
Next y
ElseIf (ws.Cells(3, m).Value = "?????????Reverts blending material") Then
With Sheets("rev")
For i = 1 To UBound(sArr, 1) - 1
k = k + 1
For j = 1 To UBound(sArr, 2)
dArr(k, j) = sArr(i, j)
Next j
Next i
.[A1:Z100000].ClearContents
If k Then .[A2].Resize(k, t.[IV1].End(xlToLeft).Column).Value = dArr
End With
For x = 1 To 10000
With Sheets("rvsmall")
.[A1:Z1].ClearContents
.[Bm] = ws.Cells(9, m).Value
.[Cm] = ws.Cells(10, m).Value
ws.Cells(x, 1).Value = Mid(ws.Cells(4, m).Value, 1, 8)
End With
Next x
ElseIf (ws.Cells(3, m).Value = "Desunfulrization magnetism flour") Then
With Sheets("ds")
For i = 1 To UBound(sArr, 1) - 1
k = k + 1
For j = 1 To UBound(sArr, 2)
dArr(k, j) = sArr(i, j)
Next j
Next i
.[A1:Z100000].ClearContents
If k Then .[A2].Resize(k, t.[IV1].End(xlToLeft).Column).Value = dArr
End With
For z = 1 To 10000
With Sheets("dssmall")
.[A1:Z1].ClearContents
.[Bm] = ws.Cells(9, m).Value
.[Cm] = ws.Cells(10, m).Value
ws.Cells(z, 1).Value = Mid(ws.Cells(4, m).Value, 1, 8)
End With
Next z
End If
Next m
End If
Next
'With Sheets("BF")
' .[A1:Z1000].ClearContents
' If k Then .[A2].Resize(k, .[IV1].End(xlToLeft).Column).Value = dArr
'End With
'End Sub
End Sub
