Nhờ các bác giúp em việc tách Tiêu chuẩn nghiệm thu, Spec, Bản vẽ theo cod VBA này ạ

Liên hệ QC

hhtoan.gs

Thành viên mới
Tham gia
24/4/20
Bài viết
3
Được thích
0
Em có cod dưới đây nhưng chỉ tách được tiêu chuẩn nghiệm thu còn, Spec, bản vẽ thì không tách được. Bác nào giỏi cod giúp em chút ạ. Em hơi gà về cod ạ.
Em xin chân thành cảm ơn
Sub TachTieuchuan(ByVal Txt As String)
Dim Tmp, I As Long, dArr(), K As Long
Tmp = Split(Txt, Chr(10))
ReDim dArr(1 To UBound(Tmp) + 1, 1 To 1)
For I = 0 To UBound(Tmp)
If Tmp(I) <> Empty Then
K = K + 1
dArr(K, 1) = Trim(Tmp(I))
End If
Next I
With Sheet2
.Range("C33:C41").EntireRow.Hidden = False
.Range("C33:Z41").ClearContents
.Range("C43:C51").EntireRow.Hidden = False
.Range("C43:Z51").ClearContents
.Range("C54:C61").EntireRow.Hidden = False
.Range("C54:Z61").ClearContents
.Range("C63:C70").EntireRow.Hidden = False
.Range("C63:Z70").ClearContents
If K Then
.Range("C33").Resize(K) = dArr
.Range("C43").Resize(K) = dArr
.Range("C54").Resize(K) = dArr
.Range("C63").Resize(K) = dArr
End If
.Range("C33:C41").SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True
.Range("C43:C51").SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True
.Range("C54:C61").SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True
.Range("C63:C70").SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True
End With
End Sub
 

File đính kèm

  • Form.Inspection.xls
    1.3 MB · Đọc: 22
Bác nào giỏi cod VBA giải thích giúp em mấy dòng cod cho em với ạ!
Sub TachTieuchuan(ByVal Txt As String)
Dim Tmp, I As Long, dArr(), K As Long
Tmp = Split(Txt, Chr(10))
ReDim dArr(1 To UBound(Tmp) + 1, 1 To 1)
For I = 0 To UBound(Tmp)
If Tmp(I) <> Empty Then
K = K + 1
dArr(K, 1) = Trim(Tmp(I))
End If
Next I
With Sheet2
.Range("C33:C41").EntireRow.Hidden = False
.Range("C33:Z41").ClearContents
If K Then
.Range("C33").Resize(K) = dArr
End If
.Range("C33:C41").SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True
End With
End Sub
 
Web KT
Back
Top Bottom