khóa rồi biết gì mà sửa bác!!. làm biếng mở khóa lắm.
Tại ô A102 ở sheet 01-Danh Muc sửa chữ "Kết thúc" thành "ket thuc" như trong code là được. Không thì anh sửa code theo ô A102.
em nghĩ chỗ này
[COLOR=#000000]For i = 15 To 400[/COLOR]
[COLOR=#000000]Sheet4.Cells(i, 1).Value = ""[/COLOR]
[COLOR=#000000]Sheet4.Cells(i, 2).Value = ""[/COLOR]
[COLOR=#000000]Sheet4.Cells(i, 3).Value = ""[/COLOR]
[COLOR=#000000]Sheet4.Cells(i, 4).Value = ""[/COLOR]
[COLOR=#000000]Next i
[/COLOR]Sheet4.Range(Cells(15,1),Cells(400,4)).value=""
400].Value=""Nhìn hông có hiểu nên hông có biết sửa sao luôn anh. Nếu tiện thì anh chỉ rõ nhật ký nó chạy ra nằm dòng nào. (Dòng 55 phải hông nhỉ?)
thì tác giả muốn dùng cells thì em dùng cells thôi mà bác cũng bắt lỗi.
Hình như là thế này: Sheet4.[A15
Nhìn hông có hiểu nên hông có biết sửa sao luôn anh. Nếu tiện thì anh chỉ rõ nhật ký nó chạy ra nằm dòng nào. (Dòng 55 phải hông nhỉ?)
400
Hehe. Thấy range rõ ràng cơ mà nên mới thò vô chứ.thì tác giả muốn dùng cells thì em dùng cells thôi mà bác cũng bắt lỗi.
không lẽ em ghi vậy rồi mà em không biết nó là vùng A15
Mã:Sheet4.[COLOR=#ff0000]Range[/COLOR](Cells(15,1),Cells(400,4)).value=""
thì em nghĩ là chắc nghĩ em không biết.Hehe. Thấy range rõ ràng cơ mà nên mới thò vô chứ.
P/s: Có câu nào nói là bạn hông biết đâu.
[COLOR=#000000]Ngoài ra khi tham chiếu đến ô [/COLOR][B][COLOR=blue]A1[/COLOR], các bạn có thể dùng code
Cách 1:Code:
Range("A1")
hoặc
Cách 2:Code:
[A1]
Trong hai cách ở trên, cách 2 ngắn gọn hơn nhưng sẽ chậm hơn cách 1.
tôi nói là bạn không biết nó là vùng A15thì tác giả muốn dùng cells thì em dùng cells thôi mà bác cũng bắt lỗi.
không lẽ em ghi vậy rồi mà em không biết nó là vùng A15
400 đấy , có ý kiến mời vào đây giao lưu
tôi nói là bạn không biết nó là vùng A15
Sub code()
Range(Cells(15, 1), Cells(400, 4)).Value = 8888
End Subcách viết này với cách viết trước của bạn đã thay đổi rồinó ghi 8888 từ A15Mã:Sub code() Range(Cells(15, 1), Cells(400, 4)).Value = 8888 End Sub
----------------------------------------
topic người ta vào chém gió hoài. chắc bị đình chỉ hoạt động quá
chắc là có mình em viết vậy quá.Hí hí, Kể từ hồi viết VBA tới giờ Ít bao giờ (có thể chưa bao giờ) mình viết kiểu vầy
Cứ toàn là Range("AxMã:[COLOR=#000000][COLOR=#000000][I]Sheet4.[/I][/COLOR][/COLOR][COLOR=#ff0000][B][I]Range[/I][/B][COLOR=#000000][I][B](Cells(15,1),Cells(400,4)[/B][/I][/COLOR][/COLOR][COLOR=#000000][COLOR=#000000][I]).value="" [/I][/COLOR][/COLOR]
Mình lạc hậu quá chăng....
[COLOR=#000000][COLOR=#000000][I]Sheet4.[/I][/COLOR][/COLOR][COLOR=#ff0000][B][I]Range[/I][/B][COLOR=#000000][I][B]([/B][/I][/COLOR][/COLOR][I]Sheet4.[/I][COLOR=#ff0000][COLOR=#000000][I][B]Cells(15,1),[/B][/I][/COLOR][/COLOR][I]Sheet4.[/I][COLOR=#ff0000][COLOR=#000000][I][B]Cells(400,4)[/B][/I][/COLOR][/COLOR][COLOR=#000000][COLOR=#000000][I]).value="" [/I][/COLOR][/COLOR]tại code trên là dùng cho sheet4 mà bác. câu trên em sửa lại rồi.
Tôi thấy nguyên tắc của viết Nhật ký từ sheet Danh muc là :
do đây chỉ là ví dụ ngày chính xác phải là 17/06
Phải chăng nên thay integer thành long rồi On error resume next và On error go to 0 dò từng đoạn hả bạn VetMini
Mình muốn bổ sung có tình huống chia cho không cũng xảy ra như thế không biết có đúng không hả bạn VetMini
Trường hợp này là vòng lặp vô tận do không thỏa điều kiện thoát chứ không phải lỗi. Bẫy lỗi cũng vô dụng.
Có thật là sửa những chỗ đó sẽ cải thiện được tốc độ không? Tôi thì tôi nghĩ những chỗ đó chả liên quan gì đến tốc độ cả.Theo tôi, muốn cải thiện tốc độ thì:1. Không đọc và ghi dữ liệu trực tiếp trên từng ô mà lấy tất cả dữ liệu vào mảng, xử lý trên mảng và ghi dữ liệu xuống sheet 1 lần.2. Thay đổi thuật toán. Thuật toán hiện tại dùng 2 vòng lặp, vòng 1 duyệt qua các ngày, vòng 2 trong vòng 1 duyệt qua tất cả các dòng của dữ liệu. Hơi phí.Lý thuyết là thế nhưng nếu cảm thấy code hiện tại không quá chậm thì cũng không nên đau đầu làm gì.
lỗi Over flow là do chỗ
Vấn đề này hôm qua đã nói tới rồi mà. Thế bạn thử viết lại xem.
Nếu em hiểu không nhầm thì em xin giải thích cách làm thôi, chứ code thì làm biếng xem lắm, nhìn chạy hoài phát ngán
tại em thấy cứ hỏi chỗ Over flow hoài nên nói lại
Mong bạn viết lại code cho tôi.
cho dù bên sheet Danh muc không có ngày nào là Mưa.
Option Explicit
Dim TGmin As Double, TGmax As Double, Itg As Double
Public Sub HamDuyet()
Dim I As Integer, J As Integer, K As Integer, H As Integer, G As Integer
Sheet4.Range("A15:A400").Resize(, 4).Value = ""
3 TGmin = Sheet5.Cells(5, 6).Value
TGmax = Sheet5.Cells(6, 6).Value
5 Itg = TGmin
K = 14: G = 1
7 Do While Itg <= TGmax
I = 15
9 Sheet4.Cells(K, 1).Value = G
Sheet4.Cells(K, 2).Value = Itg
11 Sheet4.Cells(K, 4).Value = "Mua Công truong nghi"
J = 0: H = 0
13 Do While Sheet1.Cells(I, 1).Text <> "ket thuc"
' Phan nghiem thu'
If Sheet1.Cells(I, 11).Value = Itg Then
15 Sheet4.Cells(K + J, 3).Value = Sheet1.Cells(I, 2).Value
Sheet4.Cells(K + J, 4).Value = "Nghiêm thu " & Sheet1.Cells(I, 3).Value '<=|'
17 J = J + 1: H = 1
End If
'Phan thi cong'
19 If (Sheet1.Cells(I, 6).Value <= Itg) And (Sheet1.Cells(I, 7).Value >= Itg) Then
Sheet4.Cells(K + J, 3).Value = Sheet1.Cells(I, 2).Value
21 Sheet4.Cells(K + J, 4).Value = "Thi công " + Sheet1.Cells(I, 3).Value
J = J + 1: H = 1
23 End If
I = I + 1
25 Loop
If H = 1 Then J = J - 1
27 Itg = Itg + 1
K = K + J + 1: G = G + 1
29 Loop
End Subtạm thời bạn dùng cái này xem sao nhaMong bạn viết lại code cho tôi.
1) Tôi đã nói ở #6
2) Tôi cũng không hiểu tại sao là khi công trường không thi công gì lại xuất kết quả ra là "Mua Công truong nghi"
Sub NhatKy()
Application.ScreenUpdating = False
BatDau = Sheet5.Range("F5").Value
KetThuc = Sheet5.Range("F6").Value
c = Sheet1.UsedRange.Rows.Count
j = 14
k = 1
'xoa du lieu
Sheet4.Range("A14:E100").Value = ""
'vong lap ket thuc khi ngay bat dau > ngay ket thuc
Do While BatDau <= KetThuc
For i = 18 To c
BDauau = Sheet1.Cells(i, 6).Value
KThuc = Sheet1.Cells(i, 7).Value
'kiem tra xem cong viec co namg trong khoang thoi gian xxxx khong
If BDauau <= BatDau And KThuc >= BatDau Then
'kiem tra ngay de dien vao
If KTraNgay <> BatDau Then
KTraNgay = BatDau
DienNgay = BatDau
Else
DienNgay = ""
End If
'kiem tra va dien hang muc
HMucNguon = Sheet1.Cells(i, 2).Value
If KTraHMuc <> HMucNguon Then
KTraHMuc = HMucNguon
DienHangMuc = HMucNguon
Else
DienHangMuc = ""
End If
'kien tra va dien STT
If DienNgay <> "" Then
Sheet4.Cells(j, 1) = k
k = k + 1
End If
'dien vao sheet Nhat ky
Sheet4.Cells(j, 2) = DienNgay
Sheet4.Cells(j, 3).Value = DienHangMuc 'hang muc
Sheet4.Cells(j, 4).Value = Sheet1.Cells(i, 3).Value 'noi dung cong vc
j = j + 1
End If
Next i
BatDau = BatDau + 1
Loop
Application.ScreenUpdating = True
End SubKhi viết lại bạn vẫn đi theo lối mòn của code cũ.
Do While BatDau <= KetThuc
...
BatDau = BatDau + 1
LoopFor i = BatDau To KetThuc
...
Nextđường nào cũng về la mã mà bác. Không bị lỗi vòng lặp
do while batdau <= ketthuc
...
Batdau = batdau + 1
loopTôi thấy chướng mắt nên tôi góp ý, còn chuyện bạn có tiếp nhận hay không tôi không quan tâm. Với tôi, khi điểm đầu, điểm cuối và bước nhảy cố định thì tôi dùng For... to...
Option Explicit
Sub VongLapFor()
Dim Dat1 As Date, Dat2 As Date, J As Integer
Dat1 = #9/12/2015#: Dat2 = #7/1/2015#
For J = Dat1 To Dat2
If J Mod 9 = 1 Then MsgBox Dat1 + J
Next J
End Sub
Bạn đủ khả năng giúp mà. Tôi vẫn theo dõi cho dù không hiểu code.có mỗi cái vòng lặp mà cũng bị nói XỐI XẢ
giúp người cũng bị nói. (em ngu thì em dùng cách ngu)
cáo biệt bác topic này của bác vanle33 nhe. tình hình là không đủ khả năng giúp bác rồi.
ủa ở trên có nhiều người viết code rồi mà , có gì vẫn chưa đúng sao ?Bạn đủ khả năng giúp mà. Tôi vẫn theo dõi cho dù không hiểu code.
không thoát được vòng lặp bác à
Code bài đó chỉ là viết dễ nhìn (theo í mình quen) thôi;
Public Sub helloHamDuyet()
Dim r As Long, k As Long, dArr(1 To 65000, 1 To 4), arr
Dim startDate As Date, endDate As Date, ub As Long, h As Boolean
arr = Sheet1.Range("A17:K" & Sheet1.[A65000].End(xlUp).Row).Value
ub = UBound(arr)
startDate = Sheet5.[F5].Value
endDate = Sheet5.[F6].Value
With Sheet4
.Range("A14:D" & .UsedRange.SpecialCells(xlCellTypeLastCell).Row).ClearContents
k = 1
Do While WorksheetFunction.RoundDown(startDate, 0) <= _
WorksheetFunction.RoundDown(endDate, 0)
r = 1: h = False
dArr(k, 1) = k
dArr(k, 2) = startDate
dArr(k, 4) = "Mua Công truong nghi"
Do While arr(r, 1) <> arr(ub, 1)
If arr(r, 11) = startDate Then
dArr(k, 1) = k
dArr(k, 2) = startDate
dArr(k, 3) = arr(r, 2)
dArr(k, 4) = "Nghiêm thu " & arr(r, 3)
k = k + 1: h = True
End If
If arr(r, 6) <= startDate And arr(r, 7) >= startDate Then
dArr(k, 1) = k
dArr(k, 2) = startDate
dArr(k, 3) = arr(r, 2)
dArr(k, 4) = "Thi công " & arr(r, 3)
k = k + 1: h = True
End If
r = r + 1
Loop
startDate = startDate + 1
If Not h Then k = k + 1
Loop
.Range("A14:D14").Resize(k).Value = dArr
End With
End SubstartDate = Sheet5.[F5].Value
endDate = Sheet5.[F6].Value
With Sheet4
.Range("A14:D" & .UsedRange.SpecialCells(xlCellTypeLastCell).Row).ClearContents
k = 1
Do While WorksheetFunction.RoundDown(startDate, 0) <= _
WorksheetFunction.RoundDown(endDate, 0)
' . . . . . . . . . '
Loop
Code chạy nhanh.
anh nói tới #20 thì không đơn giản
Có 2 cách để làm Nhật ký thi công
Nhiều khi không phải do Nhà thầu muốn làm thế đâu bạn mà do Chủ đầu tư quyết định, quyết luôn cho cả Tư vấn giám sát, Nhà thầu. Đâu phải cứ thẳng thắn chuẩn chỉ là đúng, là tốt đâu. Nhiều khi biết sai vẫn phải làm. Cơ chế VN nhiều khi là vậy
Nhiều khi không phải do Nhà thầu muốn làm thế đâu bạn mà do Chủ đầu tư quyết định, quyết luôn cho cả Tư vấn giám sát, Nhà thầu. Đâu phải cứ thẳng thắn chuẩn chỉ là đúng, là tốt đâu. Nhiều khi biết sai vẫn phải làm. Cơ chế VN nhiều khi là vậy
Miễn là làm việc, hoạt động trong giới hạn cho phép là OK.
Vấn đề ở đây là tôi nhờ các cao thủ chỉnh code để đạt yêu cầu.
Không biết bác có làm xây dựng không em không biết.
còn vụ bác này. cái vụ ngày giờ này kia em nghĩ được nhưng có quan trọng khôngNhiều khi không phải do Nhà thầu muốn làm thế đâu bạn mà do Chủ đầu tư quyết định, quyết luôn cho cả Tư vấn giám sát, Nhà thầu. Đâu phải cứ thẳng thắn chuẩn chỉ là đúng, là tốt đâu. Nhiều khi biết sai vẫn phải làm. Cơ chế VN nhiều khi là vậy
Miễn là làm việc, hoạt động trong giới hạn cho phép là OK.
Vấn đề ở đây là tôi nhờ các cao thủ chỉnh code để đạt yêu cầu.
Sub NhatKy()
'Application.ScreenUpdating = False
Dim MangDanhMuc, MangNhatKy(1 To 60000, 1 To 11)
Dim Khoang, i, m, c As Long
c = Sheet1.UsedRange.Rows.Count
'===============================================
MangDanhMuc = Sheet1.Range("A18:A" & c).Resize(, 11)
'm = Sheet1.[A65536].End(3).Row
BatDau = Sheet5.Range("F5").Value
KetThuc = Sheet5.Range("F6").Value
j = 1 'dong thu j
k = 1 'so thu tu
'xoa du lieu
Sheet4.Range("A14:E100").Value = ""
'vong lap ket thuc khi ngay bat dau > ngay ket thuc
Do While BatDau <= KetThuc
For i = 1 To c - 18
BD = MangDanhMuc(i, 6)
KT = MangDanhMuc(i, 7)
If BD = "" Or KT = "" Then GoTo Nex
'kiem tra xem cong viec co namg trong khoang thoi gian xxxx khong
If BD <= BatDau And KT >= BatDau Then
'kiem tra ngay de dien vao
If KTraNgay <> BatDau Then
KTraNgay = BatDau
DienNgay = BatDau
Else
DienNgay = ""
End If
'kiem tra va dien hang muc
HMucNguon = MangDanhMuc(i, 2)
If KTraHMuc <> HMucNguon Then
KTraHMuc = HMucNguon
DienHangMuc = HMucNguon
Else
DienHangMuc = ""
End If
'kien tra va dien STT
If DienNgay <> "" Then
MangNhatKy(j, 1) = k
'MsgBox MangNhatKy(j, 1)
k = k + 1
End If
'dien vao sheet Nhat ky
MangNhatKy(j, 2) = DienNgay
MangNhatKy(j, 3) = DienHangMuc 'hang muc
MangNhatKy(j, 4) = MangDanhMuc(i, 3) 'noi dung cong vc
j = j + 1
Else
For m = 1 To j
If MangNhatKy(m, 2) = BatDau Then
Tim = 1
GoTo Tiep
Else
Tim = 0
End If
Next m
Tiep:
If Tim > 0 Then
GoTo Nex
Else
If i = c - 18 Then
MangNhatKy(j, 1) = k
k = k + 1
MangNhatKy(j, 2) = BatDau
MangNhatKy(j, 4) = "Mýa, Công trýõÌng nghiÒ"
j = j + 1
End If
End If
End If
Nex:
Next i
BatDau = BatDau + 1
Loop
Range("A14:D14").Resize(j).Value = MangNhatKy
Application.ScreenUpdating = True
End SubChế một vài hạng mục độc lập thấy có vẻ là khớp nhưng nếu ráp toàn bộ hồ sơ các hạng mục của một công trình lại thì xem ra dùng excel không qua được tay cứng được đâu.
bác cho xin dữ liệu chính của bác đi. dữ liệu nháp em nhập chạy vẫn đúng.
Không phải lỗi mà là dữ liệu bác đưa sai
vậy chỉ căn cứ ngày bắt đầu với ngày nghiệm thu để điền thôi đúng không
Sub NhatKy()
Application.ScreenUpdating = False
Dim MangDanhMuc, MangNhatKy(1 To 60000, 1 To 11)
'==============================================
Dim i, m, c, STT As Long
Dim BigRng As Range
On Error Resume Next
With Sheet1.Range("A1").SpecialCells(2)
Set BigRng = .Areas(1)
For i = 1 To .Areas.Count
Set BigRng = Range(Sheet1.Cells(18, 1), .Areas(i))
Next i
End With
MangDanhMuc = BigRng
'===============================================
c = UBound(MangDanhMuc, 1)
BatDau = Sheet5.Range("F5").Value
KetThuc = Sheet5.Range("F6").Value
j = 1 'dong thu j
STT = 1 'so thu tu
'xoa du lieu
Sheet4.Range("A14:E" & Sheet4.UsedRange.Rows.Count).Value = ""
'vong lap ket thuc khi ngay bat dau > ngay ket thuc
Do While BatDau <= KetThuc
For i = 1 To c
BD = MangDanhMuc(i, 6)
If BD <> 0 Then BDTam = BD
KT = MangDanhMuc(i, 11)
'If BD = "" Or KT = "" Then GoTo Nex
'kiem tra xem cong viec co namg trong khoang thoi gian xxxx khong
If BDTam <= BatDau And KT < KetThuc Then
'kiem tra ngay de dien vao
If KTraNgay <> BatDau Then
KTraNgay = BatDau
DienNgay = BatDau
Else
DienNgay = ""
End If
'kiem tra va dien hang muc
HMucNguon = MangDanhMuc(i, 2)
If KTraHMuc <> HMucNguon Then
KTraHMuc = HMucNguon
DienHangMuc = HMucNguon
Else
DienHangMuc = ""
End If
'kien tra va dien STT
If DienNgay <> "" Then
MangNhatKy(j, 1) = STT
STT = STT + 1
End If
'dien vao sheet Nhat ky
MangNhatKy(j, 2) = DienNgay
MangNhatKy(j, 3) = DienHangMuc 'hang muc
MangNhatKy(j, 4) = MangDanhMuc(i, 3) 'noi dung cong vc
j = j + 1
Else
For m = 1 To j
If MangNhatKy(m, 2) = BatDau Then
Tim = 1
GoTo Tiep
Else
Tim = 0
End If
Next m
Tiep:
If Tim > 0 Then
GoTo Nex
Else
If i = c Then
MangNhatKy(j, 1) = STT
STT = STT + 1
MangNhatKy(j, 2) = BatDau
MangNhatKy(j, 4) = "Mua, Cong Truong Nghi"
j = j + 1
End If
End If
End If
Nex:
Next i
BatDau = BatDau + 1
Loop
Sheet4.Range("A14:D14").Resize(j).Value = MangNhatKy
Application.ScreenUpdating = True
End Sub
không lo hồ sơ 
mai lại bị cha giám sát lôi ra chém
Qua quá trình sử dụng thấy code của tác giả file Nhat ky gây lỗi do không phù hợp với dữ liệu của tôi nên phải điều chỉnh.
file này so với file #1 khác xa nhau , cột B, F,G trống trơn thì code chạy cái gì được . yêu cầu giúp về code nhưng lại đặt password VBA đã là khó chấp nhận , mà anh nói là file không phải của anh nên không biết pass mà code thì anh cập nhật liên tục vào file ?
Tôi đã nói chuyện pass VBA tại #1 bạn quét chuột chọn dòng dữ liệu sau chữ VBA đến dấu chấm sẽ thấy.
Tôi nói câu này chắc hơi vô duyên:Tôi đã nói chuyện pass VBA tại #1 bạn quét chuột chọn dòng dữ liệu sau chữ VBA đến dấu chấm sẽ thấy.
Bạn giúp tôi chỉnh code để đơn giản chỉ kết quả như #58, #57 và #78 thôi. Code của bạn đã khá OK rồi.
Vậy cái phần t bổ xung đó đúng yêu cầu chưa
lấy cái này dán vô thay thế nha
Public Sub helloHamDuyet()
Dim r As Long, k As Long, dArr(1 To 65000, 1 To 4), arr
Dim startDate As Date, endDate As Date, ub As Long, h As Boolean
arr = Sheet1.Range("A17:K" & Sheet1.[A65000].End(xlUp).Row).Value
ub = UBound(arr)
startDate = Sheet5.[F5].Value
endDate = Sheet5.[F6].Value
With Sheet4
.Range("A14:D" & .UsedRange.SpecialCells(xlCellTypeLastCell).Row).ClearContents
k = 1
Do While WorksheetFunction.RoundDown(startDate, 0) <= _
WorksheetFunction.RoundDown(endDate, 0)
r = 1: h = False
dArr(k, 1) = k
dArr(k, 2) = startDate
dArr(k, 4) = "Mua Công truong nghi"
Do While arr(r, 1) <> arr(ub, 1)
If arr(r, 11) = startDate Then
dArr(k, 1) = k
dArr(k, 2) = startDate
dArr(k, 3) = arr(r, 2)
dArr(k, 4) = "Nghiêm thu " & arr(r, 3)
k = k + 1: h = True
End If
If arr(r, 6) <= startDate And arr(r, 7) >= startDate Then
dArr(k, 1) = k
dArr(k, 2) = startDate
dArr(k, 3) = arr(r, 2)
dArr(k, 4) = "Thi công " & arr(r, 3)
k = k + 1: h = True
End If
r = r + 1
Loop
startDate = startDate + 1
If Not h Then k = k + 1
Loop
[COLOR=#ff0000]Dim l, Tren, Duoi As Long
l = 1
For i = 1 To k - 1
Tren = dArr(i, 2)
Duoi = dArr(i + 1, 2)
If Tren <> "" Then Tam = Tren
If Tam = Duoi Then
dArr(i + 1, 2) = ""
End If
If dArr(i, 2) <> "" Then
dArr(i, 1) = l
l = l + 1
Else
dArr(i, 1) = ""
End If
Next i[/COLOR]
.Range("A14:D14").Resize(k).Value = dArr
End With
End Sub
Do While Arr(R, 1) <> Arr(uB, 1)
1 If Arr(R, 11) = startDate Then
dArr(K, 1) = K: dArr(K, 2) = startDate
dArr(K, 3) = Arr(R, 2): dArr(K, 4) = "Nghiêm thu " & Arr(R, 3)
K = K + 1: H = True
End If
2 If Arr(R, 6) <= startDate And Arr(R, 7) >= startDate Then
dArr(K, 1) = K: dArr(K, 2) = startDate
dArr(K, 3) = Arr(R, 2): dArr(K, 4) = "Thi công " & Arr(R, 3)
K = K + 1: H = True
End If
R = R + 1
Loop
Đúng là 2 chỗ trên đó bác. Em không hiểu code nên không cut dán đổi vị trí 2 đoạn code trên được.Không có file thì cũng khó mà giải quyết được vấn đề;
Nhưng mình đoán là liên quan đến 2 khổ lệnh này:
Nhưng chưa rõ là cột/trường chứa các từ 'Nghiệm thu' hay 'Thi công' nằm ở nơi mô?PHP:Do While Arr(R, 1) <> Arr(uB, 1) 1 If Arr(R, 11) = startDate Then dArr(K, 1) = K: dArr(K, 2) = startDate dArr(K, 3) = Arr(R, 2): dArr(K, 4) = "Nghiêm thu " & Arr(R, 3) K = K + 1: H = True End If 2 If Arr(R, 6) <= startDate And Arr(R, 7) >= startDate Then dArr(K, 1) = K: dArr(K, 2) = startDate dArr(K, 3) = Arr(R, 2): dArr(K, 4) = "Thi công " & Arr(R, 3) K = K + 1: H = True End If R = R + 1 Loop
Nến đành chờ file hay bạn nói rõ hơn!
Dữ liệu đầu vào thì ở bên Sheet Danh mục (có thể gồm 1 vài trang hoặc 1 vài chục trang), dữ liệu được xuất ra tại Sheet Nhật ký bác ạ. Bác tạo 1 nút bấm và gán code ở #89 vào là chạy được. Nhưng chưa đúng yêu cầu như em đã nói ở #89.
Code #89 và file gửi lên không có ăn nhập gì với nhau cả. Chạy còn không được huống chi là "Chạy không đúng yêu cầu".
Sub LayDL()
Dim sArr, dArr, I As Long, k As Long, n As Long, eR As Long
sArr = Sheets("Data").Range("A4").CurrentRegion.Value
ReDim dArr(1 To UBound(sArr), 1 To 30)
Application.ScreenUpdating = False
For I = 4 To UBound(sArr)
If sArr(I, 19) <> "" Then
k = k + 1
dArr(k, 1) = k
dArr(k, 1) = sArr(I, 27)
dArr(k, 2) = sArr(I, 28)
dArr(k, 3) = sArr(I, 29)
dArr(k, 4) = sArr(I, 9)
dArr(k, 5) = "Khach le"
dArr(k, 6) = ""
dArr(k, 7) = "Phi dich vu"
dArr(k, 8) = sArr(I, 21)
dArr(k, 9) = sArr(I, 19)
dArr(k, 10) = sArr(I, 22)
dArr(k, 11) = sArr(I, 30)
dArr(k, 12) = sArr(I, 7)
dArr(k, 13) = sArr(I, 5)
End If
Next
Sheet3.Activate
Range("A2:M" & Range("A" & Rows.Count).End(xlDown).Row).Clear
If k > 0 Then Range("A2").Resize(k, 17).Value = dArr
Application.ScreenUpdating = True
For I = 4 To UBound(sArr)
If sArr(I, 26) <> 0 Then
n = n + 1
dArr(n, 1) = n
dArr(n, 1) = sArr(I, 27)
dArr(n, 2) = sArr(I, 28)
dArr(n, 3) = sArr(I, 29)
dArr(n, 4) = sArr(I, 9)
dArr(n, 5) = "Khach le"
dArr(n, 6) = ""
dArr(n, 7) = "Service Charge"
dArr(n, 8) = sArr(I, 25)
dArr(n, 9) = sArr(I, 23)
dArr(n, 10) = sArr(I, 26)
dArr(n, 11) = sArr(I, 30)
dArr(n, 12) = sArr(I, 7)
dArr(n, 13) = sArr(I, 5)
End If
Next
Sheet3.Activate
eR = Range("A" & Rows.Count).End(xlUp).Row + 1
If n > 0 Then Range("A" & eR).Resize(n, 17).Value = dArr
Application.ScreenUpdating = True
With Sheet3
[I:I].Replace What:=" VAT", Replacement:=""
Sheet3.Activate
ActiveWindow.DisplayGridlines = False
[D:D].NumberFormat = "mm/dd/yyyy"
[H:H,J:J].NumberFormat = "_(* #,##0_);_(* (#,##0);_(* ""-""_);_(@_)"
eR = Range("A" & Rows.Count).End(xlUp).Row
[N1] = "Site"
[N2].Formula = "= M2 & ""_"" & text(month(D2),""0#"")& ""_"" &right(year(D2),2)& ""_"" &Right(A2, 3)"
Range("N2:N" & eR).FillDown
With Range("N2:N" & eR)
.Value = .Value
[M:M].Delete
[A1].Select
End With
End With
End Sub
