nguyen_thi_dieu
Thành viên hoạt động



- Tham gia
- 1/11/15
- Bài viết
- 102
- Được thích
- 8
Đoạn code trong excel đây ạ
Xin cảm ơn!
Mong mọi người giúp!
Public Sub Tinh_Toan_1B(Tinh, Huyen, Xa)
Dim TenXa, Tam, Dau, Cuoi, DonVi, BaoCao(), r As Long, c As Long, cl As Long
Range("C3") = Tinh
Range("B3") = Huyen
Range("A3") = Xa
Range("A3:C3").Font.Size = 10
Range("A3:C3").Font.Bold = 1
TenXa = Range("A3")
DonVi = Range("C9:C49")
ReDim BaoCao(1 To UBound(Bieu1B), 1 To UBound(Bieu1B, 2))
For r = 2 To UBound(CSDL)
If TenXa = CSDL(r, 6) Then
Dau = r
Exit For
End If
Next r
For r = UBound(CSDL) To Dau + 1 Step -1
If TenXa = CSDL(r, 6) Then
Cuoi = r
Exit For
End If
Next r
For r = 1 To UBound(Bieu1B)
For c = 1 To UBound(Bieu1B, 2)
If Bieu1B(r, c) <> "" Then
Tam = Dong(Bieu1B(r, c), ThongSo, Dau, Cuoi)
Tam = Split(Tam)
If IsArray(Tam) = True Then
For cl = 0 To UBound(Tam)
BaoCao(r, c) = BaoCao(r, c) + CSDL(Tam(cl), IIf(Len(DonVi(r, 1)) < 4, 25, 26))
Next cl
End If
End If
Next c
Next r
Range("D9").Resize(UBound(Bieu1B), UBound(Bieu1B, 2)).ClearContents
Range("D9").Resize(UBound(Bieu1B), UBound(Bieu1B, 2)) = BaoCao
End Sub
Xin cảm ơn!
Mong mọi người giúp!
Public Sub Tinh_Toan_1B(Tinh, Huyen, Xa)
Dim TenXa, Tam, Dau, Cuoi, DonVi, BaoCao(), r As Long, c As Long, cl As Long
Range("C3") = Tinh
Range("B3") = Huyen
Range("A3") = Xa
Range("A3:C3").Font.Size = 10
Range("A3:C3").Font.Bold = 1
TenXa = Range("A3")
DonVi = Range("C9:C49")
ReDim BaoCao(1 To UBound(Bieu1B), 1 To UBound(Bieu1B, 2))
For r = 2 To UBound(CSDL)
If TenXa = CSDL(r, 6) Then
Dau = r
Exit For
End If
Next r
For r = UBound(CSDL) To Dau + 1 Step -1
If TenXa = CSDL(r, 6) Then
Cuoi = r
Exit For
End If
Next r
For r = 1 To UBound(Bieu1B)
For c = 1 To UBound(Bieu1B, 2)
If Bieu1B(r, c) <> "" Then
Tam = Dong(Bieu1B(r, c), ThongSo, Dau, Cuoi)
Tam = Split(Tam)
If IsArray(Tam) = True Then
For cl = 0 To UBound(Tam)
BaoCao(r, c) = BaoCao(r, c) + CSDL(Tam(cl), IIf(Len(DonVi(r, 1)) < 4, 25, 26))
Next cl
End If
End If
Next c
Next r
Range("D9").Resize(UBound(Bieu1B), UBound(Bieu1B, 2)).ClearContents
Range("D9").Resize(UBound(Bieu1B), UBound(Bieu1B, 2)) = BaoCao
End Sub