Nhờ cả nhà sửa giúp code với vòng lặp For-Next (2 người xem)

Liên hệ QC

Người dùng đang xem chủ đề này

Đang trực tuyến: 1 (Thành viên: 0, Khách: 1)
F

ftthua2003

Thành viên chính thức
Tham gia
15/8/08
Bài viết
97
Được thích
11
Nội dung mình gửi theo file đính kèm.
 
Sắp xếp theo thời gian sắp xếp theo bầu chọn
Có đến hơn chục cái macro có For . .. Next

Vậy biết mò cái nào ra mà mần thịt đây?
 
Upvote 0
E Xin lỗi cả nhà, e vội quá. For-next trong Command button4 ah.
Code e làm mục đích sao chép toàn bộ vùng từ SttID đến số thứ tự tiếp theo của Sheet3 sang sheet1 để tiến hành sửa.

Code e làm đây ah.
Private Sub CommandButton4_Click()
Dim I As Long
Dim SttID As Long
Dim Dongcuoi As Long
Dim sodong As Long
Dongcuoi = Sheets("NXT").[B10000].End(xlUp).Row
SttID = Sheet3.Range("A1:A" & Dongcuoi).Find(Sheet1.Cells(6, 7).Value).Row
[d5] = Sheet3.Cells(SttID, 8).Value
[d6] = Sheet3.Cells(SttID, 7).Value
[d7] = Sheet3.Cells(SttID, 9).Value
Dim Arr_n(), Arr_D()
Dim K As Long
Dim x As Integer
Dim y As Integer
Arr_n = Sheet3.Range("A1:K" & Dongcuoi).Value
sodong = UBound(Arr_n, 1)
ReDim Arr_D(1 To sodong, 1 To 6)
I = SttID
Sheet1.[c10].Value = Arr_n(I, 3)
Sheet1.[d10].Value = Arr_n(I, 4)
Sheet1.[e10].Value = Arr_n(I, 5)
Sheet1.[f10].Value = Arr_n(I, 6)
Sheet1.[g10].Value = Arr_n(I, 10)
Sheet1.[h10].Value = Arr_n(I, 11)
For I = SttID To sodong
K = K + 1
If Arr_n(I + 1, 1) = "" And Arr_n(I + 1, 1) < sodong Then
Arr_D(K, 1) = Arr_n(I + 1, 3)
Arr_D(K, 2) = Arr_n(I + 1, 4)
Arr_D(K, 3) = Arr_n(I + 1, 5)
Arr_D(K, 4) = Arr_n(I + 1, 6)
Arr_D(K, 5) = Arr_n(I + 1, 10)
Arr_D(K, 6) = Arr_n(I + 1, 11)
End If
If Arr_n(I + K, 1) <> "" Then Exit For
Next
If K > 0 Then
Sheet1.Range("C11").Resize(K, 6) = Arr_D
End If
End Sub
Code này e lấy dữ liệu từ SttID khi đến số thứ tự tiếp thì dừng vòng lặp.
 
Lần chỉnh sửa cuối:
Upvote 0
Mình gửi file và nội dung cần giúp đỡ. Mong cả nhà giúp mình với. Xin Cảm ơn cả nhà!
 
Upvote 0
ftthua2003 đã viết:
Mình gửi file và nội dung cần giúp đỡ. Mong cả nhà giúp mình với. Xin Cảm ơn cả nhà!
Nhấp chuột vào đây để mở rộng...


Tạm như thế này đi, tôi đang tắt dòng unprotect đi, bạn thích thì bật lại và nhập lại pass cho đúng cũng như thêm dòng protect ở cuối sub

Mã: 
Private Sub CommandButton4_Click()
    Dim I As Long
    Dim SttID As Long
    Dim Dongcuoi As Long
    Dim sodong As Long
    'Sheets("nxt").Unprotect (".......")
    
    Dongcuoi = Sheets("NXT").[B10000].End(xlUp).Row
    
    On Error Resume Next
    SttID = Sheet3.Range("A4:A" & Dongcuoi).Find(Sheet1.Cells(6, 7).Value).Row
    If Err.Number <> 0 Then
        MsgBox "khong tim thay ID: " & Sheet1.Cells(6, 7).Value
        On Error GoTo 0
        Exit Sub
    End If
    On Error GoTo 0
    
    With Sheet1
        .[d5] = Sheet3.Cells(SttID, 8).Value
        .[d6] = Sheet3.Cells(SttID, 7).Value
        .[d7] = Sheet3.Cells(SttID, 9).Value
    End With
        
    'them vao
    If Sheet3.Range("A" & SttID + 1) = "" Then
        sodong = Sheet3.Range("A" & SttID).End(xlDown).Row - 1
        If sodong > Dongcuoi Then sodong = Dongcuoi
    Else
        sodong = SttID
    End If
    
    Dim Arr_n(), Arr_D()
    Arr_n = Sheet3.Range("A" & SttID & ":K" & sodong).Value
    
    sodong = sodong - SttID + 1
    ReDim Arr_D(1 To sodong, 1 To 8)
    
    For I = 1 To sodong
        Arr_D(I, 1) = I
        Arr_D(I, 2) = Arr_n(I, 2)
        Arr_D(I, 3) = Arr_n(I, 3)
        Arr_D(I, 4) = Arr_n(I, 4)
        Arr_D(I, 5) = Arr_n(I, 5)
        Arr_D(I, 6) = Arr_n(I, 6)
        Arr_D(I, 7) = Arr_n(I, 10)
        Arr_D(I, 8) = Arr_n(I, 11)
    Next I
    
    Sheet1.Range("A10").Resize(1000, 8).ClearContents
    If sodong Then
        Sheet1.Range("A10").Resize(sodong, 8) = Arr_D
    End If
    
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
Có cách khác , không cần vòng lặp FOR I bài trên nữa, bạn thử xem
 
Upvote 0
ppc0312 đã viết:
Tạm như thế này đi, tôi đang tắt dòng unprotect đi, bạn thích thì bật lại và nhập lại pass cho đúng cũng như thêm dòng protect ở cuối sub

Mã: 
Private Sub CommandButton4_Click()
    Dim I As Long
    Dim SttID As Long
    Dim Dongcuoi As Long
    Dim sodong As Long
    'Sheets("nxt").Unprotect (".......")
    
    Dongcuoi = Sheets("NXT").[B10000].End(xlUp).Row
    
    On Error Resume Next
    SttID = Sheet3.Range("A4:A" & Dongcuoi).Find(Sheet1.Cells(6, 7).Value).Row
    If Err.Number <> 0 Then
        MsgBox "khong tim thay ID: " & Sheet1.Cells(6, 7).Value
        On Error GoTo 0
        Exit Sub
    End If
    On Error GoTo 0
    
    With Sheet1
        .[d5] = Sheet3.Cells(SttID, 8).Value
        .[d6] = Sheet3.Cells(SttID, 7).Value
        .[d7] = Sheet3.Cells(SttID, 9).Value
    End With
        
    'them vao
    If Sheet3.Range("A" & SttID + 1) = "" Then
        sodong = Sheet3.Range("A" & SttID).End(xlDown).Row - 1
        If sodong > Dongcuoi Then sodong = Dongcuoi
    Else
        sodong = SttID
    End If
    
    Dim Arr_n(), Arr_D()
    Arr_n = Sheet3.Range("A" & SttID & ":K" & sodong).Value
    
    sodong = sodong - SttID + 1
    ReDim Arr_D(1 To sodong, 1 To 8)
    
    For I = 1 To sodong
        Arr_D(I, 1) = I
        Arr_D(I, 2) = Arr_n(I, 2)
        Arr_D(I, 3) = Arr_n(I, 3)
        Arr_D(I, 4) = Arr_n(I, 4)
        Arr_D(I, 5) = Arr_n(I, 5)
        Arr_D(I, 6) = Arr_n(I, 6)
        Arr_D(I, 7) = Arr_n(I, 10)
        Arr_D(I, 8) = Arr_n(I, 11)
    Next I
    
    Sheet1.Range("A10").Resize(1000, 8).ClearContents
    If sodong Then
        Sheet1.Range("A10").Resize(sodong, 8) = Arr_D
    End If
    
End Sub
Nhấp chuột vào đây để mở rộng...
Cảm ơn bạn đã giúp đỡ.
Bạn giúp mình xem lại úng Với STT =1 code cho kết quả chưa đúng như yêu cầu. Minh chưa tìm ra lỗi.
 
Upvote 0
ftthua2003 đã viết:
Cảm ơn bạn đã giúp đỡ.
Bạn giúp mình xem lại úng Với STT =1 code cho kết quả chưa đúng như yêu cầu. Minh chưa tìm ra lỗi.
Nhấp chuột vào đây để mở rộng...

vậy thử code vui này

Mã: 
Private Sub CommandButton4_Click()
Dim b12e082c4c0299ec9224c37bfefe4a220 As Long: Dim mf95e6236034cd36ef091e2f692a307d8 As Long: Dim z84db329f2b612ea7072088e7adc8e094 As Long: Dim zcfa0609cbd34b474b39e740567b1d2fc As Long
z84db329f2b612ea7072088e7adc8e094 = Sheets("NXT").[B10000].End(xlUp).Row
On Error Resume Next
mf95e6236034cd36ef091e2f692a307d8 = Sheet3.Range("A1:A" & z84db329f2b612ea7072088e7adc8e094).Find(Sheet1.Cells(6, 7).Value).Row
If Err.Number <> 0 Then
MsgBox "khong tim thay ID & " & Sheet1.Cells(6, 7).Value
On Error GoTo 0
Exit Sub
End If
On Error GoTo 0
With Sheet1
.[d5] = Sheet3.Cells(mf95e6236034cd36ef091e2f692a307d8, 8).Value
.[d6] = Sheet3.Cells(mf95e6236034cd36ef091e2f692a307d8, 7).Value
.[d7] = Sheet3.Cells(mf95e6236034cd36ef091e2f692a307d8, 9).Value
End With
If Sheet3.Range("A" & mf95e6236034cd36ef091e2f692a307d8 + 1) = "" Then
zcfa0609cbd34b474b39e740567b1d2fc = Sheet3.Range("A" & mf95e6236034cd36ef091e2f692a307d8).End(xlDown).Row - 1
If zcfa0609cbd34b474b39e740567b1d2fc > z84db329f2b612ea7072088e7adc8e094 Then zcfa0609cbd34b474b39e740567b1d2fc = z84db329f2b612ea7072088e7adc8e094
Else
zcfa0609cbd34b474b39e740567b1d2fc = mf95e6236034cd36ef091e2f692a307d8
End If
Dim b0f1f6301f057c852173ae7b0045d38b3(), b08c606139aa4c989f7db551da5821ec1()
b0f1f6301f057c852173ae7b0045d38b3 = Sheet3.Range("A" & mf95e6236034cd36ef091e2f692a307d8 & ":K" & zcfa0609cbd34b474b39e740567b1d2fc).Value
zcfa0609cbd34b474b39e740567b1d2fc = zcfa0609cbd34b474b39e740567b1d2fc - mf95e6236034cd36ef091e2f692a307d8 + 1
ReDim b08c606139aa4c989f7db551da5821ec1(1 To zcfa0609cbd34b474b39e740567b1d2fc, 1 To 8)
For b12e082c4c0299ec9224c37bfefe4a220 = 1 To zcfa0609cbd34b474b39e740567b1d2fc
b08c606139aa4c989f7db551da5821ec1(b12e082c4c0299ec9224c37bfefe4a220, 1) = b12e082c4c0299ec9224c37bfefe4a220
b08c606139aa4c989f7db551da5821ec1(b12e082c4c0299ec9224c37bfefe4a220, 2) = b0f1f6301f057c852173ae7b0045d38b3(b12e082c4c0299ec9224c37bfefe4a220, 2)
b08c606139aa4c989f7db551da5821ec1(b12e082c4c0299ec9224c37bfefe4a220, 3) = b0f1f6301f057c852173ae7b0045d38b3(b12e082c4c0299ec9224c37bfefe4a220, 3)
b08c606139aa4c989f7db551da5821ec1(b12e082c4c0299ec9224c37bfefe4a220, 4) = b0f1f6301f057c852173ae7b0045d38b3(b12e082c4c0299ec9224c37bfefe4a220, 4)
b08c606139aa4c989f7db551da5821ec1(b12e082c4c0299ec9224c37bfefe4a220, 5) = b0f1f6301f057c852173ae7b0045d38b3(b12e082c4c0299ec9224c37bfefe4a220, 5)
b08c606139aa4c989f7db551da5821ec1(b12e082c4c0299ec9224c37bfefe4a220, 6) = b0f1f6301f057c852173ae7b0045d38b3(b12e082c4c0299ec9224c37bfefe4a220, 6)
b08c606139aa4c989f7db551da5821ec1(b12e082c4c0299ec9224c37bfefe4a220, 7) = b0f1f6301f057c852173ae7b0045d38b3(b12e082c4c0299ec9224c37bfefe4a220, 10)
b08c606139aa4c989f7db551da5821ec1(b12e082c4c0299ec9224c37bfefe4a220, 8) = b0f1f6301f057c852173ae7b0045d38b3(b12e082c4c0299ec9224c37bfefe4a220, 11)
Next b12e082c4c0299ec9224c37bfefe4a220
Sheet1.Range("A10").Resize(1000, 8).ClearContents
If zcfa0609cbd34b474b39e740567b1d2fc Then
Sheet1.Range("A10").Resize(zcfa0609cbd34b474b39e740567b1d2fc, 8) = b08c606139aa4c989f7db551da5821ec1
End If
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
Vậy bạn sửa gọn lại thế này (Tạm mượn code của bạn ppc0312 nhé)
Mã: 
Private Sub CommandButton4_Click()
Dim So1 As Long: Dim So2 As Long: Dim So3 As Long: Dim So4 As Long
So3 = Sheets("NXT").[B10000].End(xlUp).Row
On Error Resume Next
So2 = Sheet3.Range("A1:A" & So3).Find(Sheet1.Cells(6, 7).Value).Row
If Err.Number <> 0 Then
MsgBox "khong tim thay ID & " & Sheet1.Cells(6, 7).Value
On Error GoTo 0
Exit Sub
End If
On Error GoTo 0
With Sheet1
.[d5] = Sheet3.Cells(So2, 8).Value
.[d6] = Sheet3.Cells(So2, 7).Value
.[d7] = Sheet3.Cells(So2, 9).Value
End With
If Sheet3.Range("A" & So2 + 1) = "" Then
So4 = Sheet3.Range("A" & So2).End(xlDown).Row - 1
If So4 > So3 Then So4 = So3
Else
So4 = So2
End If
Dim Mang1(), Mang2()
Mang1 = Sheet3.Range("A" & So2 & ":K" & So4).Value
So4 = So4 - So2 + 1
ReDim Mang2(1 To So4, 1 To 8)
For So1 = 1 To So4
Mang2(So1, 1) = So1
Mang2(So1, 2) = Mang1(So1, 2)
Mang2(So1, 3) = Mang1(So1, 3)
Mang2(So1, 4) = Mang1(So1, 4)
Mang2(So1, 5) = Mang1(So1, 5)
Mang2(So1, 6) = Mang1(So1, 6)
Mang2(So1, 7) = Mang1(So1, 10)
Mang2(So1, 8) = Mang1(So1, 11)
Next So1
Sheet1.Range("A10").Resize(1000, 8).ClearContents
If So4 Then
Sheet1.Range("A10").Resize(So4, 8) = Mang2
End If
End Sub
 
Upvote 0
giaiphap đã viết:
Vậy bạn sửa gọn lại thế này (Tạm mượn code của bạn ppc0312 nhé)
Mã: 
Private Sub CommandButton4_Click()
Dim So1 As Long: Dim So2 As Long: Dim So3 As Long: Dim So4 As Long
So3 = Sheets("NXT").[B10000].End(xlUp).Row
On Error Resume Next
So2 = Sheet3.Range("A1:A" & So3).Find(Sheet1.Cells(6, 7).Value).Row
If Err.Number <> 0 Then
MsgBox "khong tim thay ID & " & Sheet1.Cells(6, 7).Value
On Error GoTo 0
Exit Sub
End If
On Error GoTo 0
With Sheet1
.[d5] = Sheet3.Cells(So2, 8).Value
.[d6] = Sheet3.Cells(So2, 7).Value
.[d7] = Sheet3.Cells(So2, 9).Value
End With
If Sheet3.Range("A" & So2 + 1) = "" Then
So4 = Sheet3.Range("A" & So2).End(xlDown).Row - 1
If So4 > So3 Then So4 = So3
Else
So4 = So2
End If
Dim Mang1(), Mang2()
Mang1 = Sheet3.Range("A" & So2 & ":K" & So4).Value
[COLOR=#ff0000]So4 = So4 - So2 + 1
[/COLOR][COLOR=#0000ff][B]ReDim Mang2(1 To So4, 1 To 8)[/B][/COLOR][COLOR=#ff0000]
For So1 = 1 To So4
Mang2(So1, 1) = So1
Mang2(So1, 2) = Mang1(So1, 2)
Mang2(So1, 3) = Mang1(So1, 3)
Mang2(So1, 4) = Mang1(So1, 4)
Mang2(So1, 5) = Mang1(So1, 5)
Mang2(So1, 6) = Mang1(So1, 6)
Mang2(So1, 7) = Mang1(So1, 10)
Mang2(So1, 8) = Mang1(So1, 11)
Next So1
Sheet1.Range("A10").Resize(1000, 8).ClearContents
[/COLOR][COLOR=#0000ff][B]If So4 Then[/B][/COLOR][COLOR=#ff0000]
Sheet1.Range("A10").Resize(So4, 8) = Mang2
End If[/COLOR]
End Sub
Nhấp chuột vào đây để mở rộng...

Bạn phải test So4 trước khi Redim mảng chứ!
 
Upvote 0
Cảm ơn ppc0312 và giaiphap rất nhiều. Mình còn vấn đề này các bạn giúp mình nhé.
Các bạn cho mình hỏi thêm, khi mình lấy dữ liệu xong mình chỉnh sửa số liệu rồi mình lưu lại tại số thứ tự (ID) đó. Nhưng trong quá trình sửa dữ liệu cũ mình có bổ sung vài dòng mới dưới dữ liệu cũ thì code phát sinh sẽ như thế nào nhỉ, mình đang mù tịt. Các bạn giúp mình với nhé.
 
Upvote 0
Dựa vào cót của ppc0312, giaiphap, mình sửa đổi được code sau
Code này nếu vùng sữa chữa mới nhiều hơn vùng dữ liệu cũ thì chèn vào dòng cuối của dữ liệu cũ đó. Còn Vùng mới ít hơn Vùng dữ liệu cũ thì xóa bớt dòng.
Mình thử code chạy, nhưng code dài quá.
Mình nhờ các anh, các bạn xem còn cách nào ngắn gọn hơn không.
Xin cảm ơn!!!
Xin chúc cả nhà Giáng sinh an lành!!! :santa2::santa2::santa2:

Private Sub CommandButton5_Click()
Dim So1 As Long: Dim So2 As Long: Dim So3 As Long: Dim So4 As Long: Dim dongcuoi1 As Long
Dim r As Long
ActiveSheet.Unprotect "0984330781"
Sheet3.Unprotect "0984330781"
So3 = Sheets("NXT").[B10000].End(xlUp).Row
dongcuoi1 = Sheets("XN").[c10000].End(xlUp).Row
On Error Resume Next
So2 = Sheet3.Range("A1:A" & So3).Find(Sheet1.Cells(6, 7).Value).Row
If Err.Number <> 0 Then
MsgBox "khong tim thay ID & " & Sheet1.Cells(6, 7).Value
On Error GoTo 0
Exit Sub
End If
On Error GoTo 0
With Sheet3
.Cells(1, So2).Value = Sheet1.[g6].Value
End With
If Sheet3.Range("A" & So2 + 1) = "" Then
So4 = Sheet3.Range("A" & So2).End(xlDown).Row - 1
If So4 > So3 Then So4 = So3
Else
So4 = So2
End If
Dim Mang1(), Mang2()
Mang2 = Sheet1.Range("b10:K" & dongcuoi1).Value
So4 = So4 - So2 + 1
r = Application.CountA(Sheet1.Range("c10:c" & dongcuoi1))
If r > So4 Then
Sheet3.Range("A" & So4 + So2).Resize(r - So4).EntireRow.Insert
ReDim Mang1(1 To r, 1 To 10)
For So1 = 1 To r
Mang1(So1, 1) = Mang2(So1, 1)
Mang1(So1, 2) = Mang2(So1, 2)
Mang1(So1, 3) = Mang2(So1, 3)
Mang1(So1, 4) = Mang2(So1, 4)
Mang1(So1, 5) = Mang2(So1, 5)
Mang1(So1, 6) = [d6].Value
Mang1(So1, 7) = [d5].Value
Mang1(So1, 9) = Mang2(So1, 7)
Mang1(So1, 10) = Mang2(So1, 8)
Next So1
Sheet3.Range("b" & So2).Resize(r, 10).ClearContents
If r Then
Sheet3.Range("b" & So2).Resize(r, 10) = Mang1
End If
If [g4].Value = "PX" Then
Sheet3.Cells(So2, 9).Value = [d7].Value
End If
ElseIf r < So4 Then
Sheet3.Range("A" & So4 + So2).Resize(r - So4).EntireRow.Delete
ReDim Mang1(1 To So4, 1 To 10)
For So1 = 1 To So4
Mang1(So1, 1) = Mang2(So1, 1)
Mang1(So1, 2) = Mang2(So1, 2)
Mang1(So1, 3) = Mang2(So1, 3)
Mang1(So1, 4) = Mang2(So1, 4)
Mang1(So1, 5) = Mang2(So1, 5)
Mang1(So1, 6) = [d6].Value
Mang1(So1, 7) = [d5].Value
Mang1(So1, 9) = Mang2(So1, 7)
Mang1(So1, 10) = Mang2(So1, 8)
Next So1
Sheet3.Range("b" & So2).Resize(r, 10).ClearContents
If r Then
Sheet3.Range("b" & So2).Resize(r, 10) = Mang1
End If
If [g4].Value = "PX" Then
Sheet3.Cells(So2, 9).Value = [d7].Value
End If
ElseIf r = So4 Then
ReDim Mang1(1 To r, 1 To 10)
For So1 = 1 To r
Mang1(So1, 1) = Mang2(So1, 1)
Mang1(So1, 2) = Mang2(So1, 2)
Mang1(So1, 3) = Mang2(So1, 3)
Mang1(So1, 4) = Mang2(So1, 4)
Mang1(So1, 5) = Mang2(So1, 5)
Mang1(So1, 6) = [d6].Value
Mang1(So1, 7) = [d5].Value
Mang1(So1, 9) = Mang2(So1, 7)
Mang1(So1, 10) = Mang2(So1, 8)
Next So1
Sheet3.Range("b" & So2).Resize(r, 10).ClearContents
If r Then
Sheet3.Range("b" & So2).Resize(r, 10) = Mang1
End If
If [g4].Value = "PX" Then
Sheet3.Cells(So2, 9).Value = [d7].Value
End If
End If
End Sub
 
Upvote 0
ftthua2003 đã viết:
Code đúng rồi bạn.
Nhưng nhìn rối quá. Ecec
Nhấp chuột vào đây để mở rộng...

Vẫn là code giống bài trên , chỉ thay A4 thành A1
Mã: 
Private Sub CommandButton4_Click()
    Dim I As Long
    Dim SttID As Long
    Dim Dongcuoi As Long
    Dim sodong As Long
    'Sheets("nxt").Unprotect (".......")
    
    Dongcuoi = Sheets("NXT").[B10000].End(xlUp).Row
    
    On Error Resume Next
    SttID = Sheet3.Range("A1:A" & Dongcuoi).Find(Sheet1.Cells(6, 7).Value).Row
    If Err.Number <> 0 Then
        MsgBox "khong tim thay ID: " & Sheet1.Cells(6, 7).Value
        On Error GoTo 0
        Exit Sub
    End If
    On Error GoTo 0
    
    With Sheet1
        .[d5] = Sheet3.Cells(SttID, 8).Value
        .[d6] = Sheet3.Cells(SttID, 7).Value
        .[d7] = Sheet3.Cells(SttID, 9).Value
    End With
        
    'them vao
    If Sheet3.Range("A" & SttID + 1) = "" Then
        sodong = Sheet3.Range("A" & SttID).End(xlDown).Row - 1
        If sodong > Dongcuoi Then sodong = Dongcuoi
    Else
        sodong = SttID
    End If
    
    Dim Arr_n(), Arr_D()
    Arr_n = Sheet3.Range("A" & SttID & ":K" & sodong).Value
    
    sodong = sodong - SttID + 1
    ReDim Arr_D(1 To sodong, 1 To 8)
    
    For I = 1 To sodong
        Arr_D(I, 1) = I
        Arr_D(I, 2) = Arr_n(I, 2)
        Arr_D(I, 3) = Arr_n(I, 3)
        Arr_D(I, 4) = Arr_n(I, 4)
        Arr_D(I, 5) = Arr_n(I, 5)
        Arr_D(I, 6) = Arr_n(I, 6)
        Arr_D(I, 7) = Arr_n(I, 10)
        Arr_D(I, 8) = Arr_n(I, 11)
    Next I
    
    Sheet1.Range("A10").Resize(1000, 8).ClearContents
    If sodong Then
        Sheet1.Range("A10").Resize(sodong, 8) = Arr_D
    End If
    
End Sub
 
Upvote 0
ftthua2003 đã viết:
Dựa vào cót của ppc0312, giaiphap, mình sửa đổi được code sau
Code này nếu vùng sữa chữa mới nhiều hơn vùng dữ liệu cũ thì chèn vào dòng cuối của dữ liệu cũ đó. Còn Vùng mới ít hơn Vùng dữ liệu cũ thì xóa bớt dòng.
Mình thử code chạy, nhưng code dài quá.
Mình nhờ các anh, các bạn xem còn cách nào ngắn gọn hơn không.
Nhấp chuột vào đây để mở rộng...

Nó chạy ra kết quả rồi thì cứ để đó mà chạy. Sửa đổi chi?
Khi nào bạn không thể áp dụng được nữa thì viết lại.

Nói thẳng. Code trên không xứng đáng sửa lại cho gọn. Người ta chỉ sửa code cho nó tổng quát, dùng vào nhiều trường hợp, tức là chỉ phải chỉnh 1 bài thông số.

Code này của bạn có các điểm sau:
1. nhiệm vụ quá đặc thù
2. thuật toán quá luộm thuộm
3. phương pháp (style) viết code không đồng bộ
4. kỹ thuật viết cho loại code chỉ dùng 1 lần - không thể sửa để dùng vào trường hợp khác.

Điểm 3:
vd lúc thì Sheet1, Sheet2, Sheet3, lúc thì Sheets(sheetName)
lúc thì Range(...) lúc thì [...], chả có thống nhất gì cả

Điểm 4:
Code có trị cứng (magic numbers) là loại kỹ thuật viết code chỉ dùng một lần
Theo tiếng chuyên môn lập trình, trị cứng (magic numbers) là các chỗ như
Mang1(So1, 1) = Mang2(So1, 1)
Mang1(So1, 2) = Mang2(So1, 2)
Mang1(So1, 3) = Mang2(So1, 3)
Mang1(So1, 4) = Mang2(So1, 4)
Mang1(So1, 5) = Mang2(So1, 5)
Mang1(So1, 6) = [d6].Value
Mang1(So1, 7) = [d5].Value
Mang1(So1, 9) = Mang2(So1, 7)
Mang1(So1, 10) = Mang2(So1, 8)

Điểm 4 phụ:
Kỹ thuật viết code dài sòng sọc, không phân ra thành hàm con cũng là kỹ thuật viết code chỉ dùng 1 lần.

Chú ý:
Trong điểm 4 trên, tôi có gợi ý cách thâu gọn code lại. Những đoạn code gần giống nhau bạn có thể tách chúng riêng ra thành hàm con.
 
Upvote 0
Cảm ơn bác Vetmini đã góp ý kiến.
- Mình dân kỹ thuật Xây dựng nên về kỹ năng lập trình mình mù tịt, có chăng chỉ học qua loa lấy lệ trên ghế Đại học đại cương.
- Mình mới tập tành học VBA được 4 tháng nay. Vì mình thấy VBA rất hay, tiết kiệm được rất nhiều thời gian, nên cái gì lặp đi lặp lại là mình thử chuyển qua VBA để nghiên cứu. Nên toàn bộ code trên mình lên GPE copy, sao chép để phục vụ mục đích của mình. Cái gì không làm được thì nhờ cả nhà GPE giúp đỡ. Nên Code không đồng bộ thì chắc chắn rồi. hiiii
Còn kỹ thuật viết code như thế nào mình cũng chẳng biết nói như thế nào cả. Vì Mình cứ suy nghĩ từng bước code làm gì thì mình viết từng bước như thế.
Đây là sổ nhập,xuất kho hằng ngày ở công trường mình viết để theo dõi hằng ngày. và cũng tạm gọi là code đầu tay. Do đó mình sẽ gửi toàn bộ file lên GPE nếu được Bác Vetmini cả nhà quan tâm xem và sửa giúp mình thì không còn gì tuyệt vời hơn.
Xin cảm ơn Bac Vetmini rất nhiều.
 
Upvote 0
ftthua2003 đã viết:
Cam ơn bạn PPC0312 nhieu nhé.
Nhờ bạn và cả nhà xem qua code bài http://www.giaiphapexcel.com/forum/...ode-với-vòng-lặp-For-Next&p=697787#post697787 giúp mình với.
Nhấp chuột vào đây để mở rộng...
Dựa vào cót của ppc0312,....
Nhấp chuột vào đây để mở rộng...

Tất cả code trên vẫn của bạn đấy thôi, tôi chỉ sửa cho nó chạy đúng lại cho bạn, tôi không viết lại từ đầu.

Vì tôi là đại lãm, cũng như giữ code của bạn để bạn còn hiểu và áp dụng, nên các bài trước chỉ sửa code của chính bạn như trên đó. Còn phần mới thì tôi chưa xem kỹ. Nhìn qua tôi thấy nếu sửa thì bỏ hết làm mới từ đầu, vậy thui, để đợi thành viên nào đó sửa cho bạn giúp bạn hiểu hơn thì hay hơn.
 
Lần chỉnh sửa cuối:
Upvote 0
ftthua2003 đã viết:
Cảm ơn bác Vetmini đã góp ý kiến.
- Mình dân kỹ thuật Xây dựng nên về kỹ năng lập trình mình mù tịt, có chăng chỉ học qua loa lấy lệ trên ghế Đại học đại cương.
...
Nhấp chuột vào đây để mở rộng...

Tôi cũng từng học trường ĐH BK tpHCM
Tuy tôi không học ngành xây dựng nhưng chúng tôi, tức là mọi ngành, đều học chung môn lập trình.
Vì vậy tôi biết khả năng lập trình của dân ngành chính quy xây dựng.
Chuyện qua loa thì có lẽ do trường học của bạn, không phải do ngành học.
 
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

Bài viết mới nhất

H
Hàm Evaluate bị lỗi khi mở lại (2 người xem)
Trả lời
2
Đọc
43
VetMini
V
H
Phân quyền xem trên từng trang tính của googlesheet (1 người xem)
Trả lời
0
Đọc
13
Hoale85
H
D
Nhờ mọi người giúp với. file đính kèm ạh
Trả lời
0
Đọc
28
doantncd
D
E
Tính tổng tiền theo điều kiện
Trả lời
5
Đọc
100
mimosa1972
M
vnxgiokinhtoi
Nhờ giúp đỡ công thức lưu dữ liệu và mở lại dữ liệu cũ đã save
Trả lời
0
Đọc
19
vnxgiokinhtoi
vnxgiokinhtoi
N
  • Question Question
TÌM TÊN CỘT VÀ COPY CẢ CỘT SANG SHEET KHÁC BẰNG VBA
Trả lời
5
Đọc
105
ngoc0977760224
N
N
  • Question Question
VBA - copy các sheets unhide và dạng giá trị theo vùng xác định
Trả lời
7
Đọc
413
nguyenhuong91
N
A
  • Question Question
Nhờ các bác giúp em viết code để trích lọc và so sánh với 5 điều kiện. Em suy nghĩ mãi không làm được. em cám ơn
Trả lời
4
Đọc
80
Hoàng Tuấn 868
H
H
  • Question Question
Gửi mail hàng loạt với mỗi mail là 1 file PDF đính kèm khác nhau
Trả lời
2
Đọc
139
Cúc Hr
C
M
  • Question Question
Tự chèn dòng khi cập nhật dữ liệu từ trang tính khác.
Trả lời
5
Đọc
185
Cúc Hr
C
T
Nhờ ACE chỉ giáo công thức Gộp nhiều dữ liệu vào một ô trong excel
Trả lời
5
Đọc
90
minhminh27
minhminh27
PhanTuHuong
Nên chọn điện thoại nào?
Trả lời
17
Đọc
1K
minhminh27
minhminh27
N
Em đang muốn tìm sách. Tài.liệu về dashboard và báo cáo, biểu đồ excel tiếng việt
Trả lời
1
Đọc
59
ptm0412
ptm0412
Q
Phát tiếng khi code chạy ra giá trị yêu cầu
    • Cười
Trả lời
3
Đọc
139
DeTong
D
A
  • Question Question
nhờ anh chị, chú bác giúp em gom gọn phần code phía dưới giúp em. Sao bị lỗi ở dòng 24, 25, 26 nữa ạ. em cám ơn
Trả lời
3
Đọc
73
Hoàng Tuấn 868
H
J
Excel 2019, lỗi không thể insert được biểu đồ (chart) (1 người xem)
Trả lời
12
Đọc
4K
ptm0412
ptm0412
C
Lọc chỉ tiêu sheet 1, kết quả tự động ở các sheet còn lại
Trả lời
10
Đọc
158
thuytrangbp28
T
A
  • Question Question
Em nhờ anh/chị/em/chú/bác giúp em viết code tổng hợp dữ liệu. em tính công thức nó nặng quá. em cám ơn (1 người xem)
Trả lời
13
Đọc
328
HUONGHCKT
H
P
  • Question Question
Lấy giá trị duy nhất nhiều cột khác nhau
Trả lời
5
Đọc
193
phamgiang90
P
T
  • Question Question
Xin thầy/cô và anh chị giúp đỡ cách điền thông tin ca kíp trực trong bảng Excel bằng VBA
Trả lời
1
Đọc
104
HUONGHCKT
H
Xem thêm…

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Đếm ngược thời gian

000
Ngày
00
Giờ
00
phút
00
giây
TALKSHOW KHÁM PHÁ SỨC MẠNH HÀM FILTER TRONG EXCEL 365
Back
Top Bottom