Nhờ cả nhà sửa giúp code với vòng lặp For-Next (1 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
To Bác VietMini

VetMini đã viết:
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.
Nhấp chuột vào đây để mở rộng...
Máy hôm nay do bận công việc nên chưa trả lời Bác được.
- Mình cũng dân BKDN, mình nhớ luc đó học C thì phải. Trường thì đào tạo bài bản, nhưng lúc đó học chỉ mong thi qua môn nên ra trường 10 năm nay không sử dụng đến nên không còn nhớ tí nào cả. Nên bây giờ nghiên cứu VBA mình phải bắt đầu từ con số 0.
- Mình cũng chỉ mong khi học VBA phục vụ công việc của mình mà thôi.
Qua diễn đàn GPE mình thấy Bác am hiểu, kiến thức về VBA và những môn lập trình khác rất rộng và sâu. Mình rất hâm mộ.
Vài lời chia sẻ cùng Bác VetMini.
 
Upvote 0
Mình có 02 vấn đề mong được cả nhà giúp đỡ!
- Hôm nay mình mới copy toàn bộ dữ liệu vào file thì khi kích chọn trong sự kiện Selection Change hiện ListBox để nhập liệu và tìm kiếm tên vật tư, sự kiện Selection Change hiện ListBox xử lý rất chậm. Xin cả nhà chỉ giúp cách xử lý nhanh hơn.
- Và như Bài #18 mình đã nói, mình đưa file Nhập xuất của mình lên , mong được các bạn xem qua và góp ý giúp mình để file hoàn thiện hơn.
Code trong file có sử dụng các anh chị đã góp ý và hướng dẫn.
Xin cảm ơn rất nhiều!
 

File đính kèm

Upvote 0
hpkhuong đã viết:
Dòng đỏ đỏ ở trên í bạn là sao??? Khi lick chuột vào vùng điều kiện thì Sự kiện show cái User Form của bạn lên có độ trễ hay sao???
Nhấp chuột vào đây để mở rộng...
Như bạn nói User form có độ trễ, với dữ liệu ít thì chạy được nhưng với Dữ liệu mình Mail lên GPE thì xử lý chậm hơn rất nhiều. Tương lai trong quá trình mình sử dụng khi Phần Dữ liệu cập nhật bổ sung nữa thì mình nghĩ Sử dụng User Form chắc Tèo quá.
hpkhuong đã viết:
Nếu muốn thì dòng đỏ đỏ ấy không cần user form, có thể làm trực tiếp trên Range (sheet) đó luôn thông qua 1 vài cái textbox+listbox sẽ cho tốc độ nhanh hơn show form...
Nhấp chuột vào đây để mở rộng...
Trước kia mình có sử dụng Combobox để nhập liệu nhưng để tìm kiếm tên vật tư trên Combobox mình làm không được. Nên có nhờ diễn đàn giúp đỡ và chuyển qua UserForm như Bảng hiện tại.
Nếu được bạn giúp đỡ kết hợp nhập liệu bẳng textbox+listbox và kèm chức năng bổ sung "Khi ta gõ 1 kí tự bất kỳ vào textbox thì sẽ hiển thị toàn bộ tên vật tư lên Listbox để chọn tên vật tư đó và các sự kiện như dùng mũi tên bàn phím, lăn chuột, tab để chọn nữa " thì quả thật không còn gì tuyệt vời hơn.
Xin cảm ơn bạn rất nhiều và mong có kết quả thành công mỹ mãn.
 
Upvote 0
hpkhuong đã viết:
cảm nhận nó như thế nào nhé!
Chỉ vậy thôi...!
Nhấp chuột vào đây để mở rộng...
Thật tuyệt vời bạn hpkhuong!!!
- File chạy nhanh hơn sử dụng User Form rất nhiều Và linh hoạt hơn về cách nhập liệu vào bảng tính(File đã sử dụng nhiều sự kiện của bàn phím và chuột vào lựa chọn).
Chỉ còn 1 tí nữa là hoàn hảo đó là chỉnh lại độ rộng 4 cột trong Listbox1 và Listbox2. Mình đã xem code xử lý độ rộng nhưng mình chỉnh lại chưa được, mình nghĩ ở chổ này.Col = ActiveCell.Offset(1).Width
ColA = 0.1 * Col + 0.2 * Col + 0.55 * Col
ColB = 0.1 * Col & ";" & 0.2 * Col & ";" & 0.55 * Col & ";" & Col - ColA - 4
Bạn sửa giúp mình theo khoảng cách giữa các cột theo hình sau giúp mình với.
Cảm ơn bạn hpkhuong!!! rất nhiều!!!
 

File đính kèm

  • Hình 4 cot.jpg
    Hình 4 cot.jpg
    8.2 KB · Đọc: 12
Upvote 0
- Độ rộng của Listbox1 và listbox 2 co dãn theo Cột D thì đúng rồi bạn.
- Nhưng Trong List box1 và Listbox2 mình có chia ra thành 4 cột lần lượt chứa tên (Số thứ tự; Mã vật tư; tên vật tư; Đvt)- Ý mình ở đây là chỉnh lại độ rộng của các cột trong 2 Listbox đó. Vì như bạn thấy cột chứa Đvt mình không cần rộng như vậy, mà ở đây Cột mình cần rộng là cột chứaTên vật tư, như vậy mình đọc tên vật tư dễ hơn và khai thác hết độ rộng cột trên Listbox)
Nên ý mình gửi hình lên để bạn canh tỷ lệ độ rộng của các cột theo hình đó một cách tương đối.
Xin cảm ơn bạn rất nhiều.
 
Upvote 0
hpkhuong đã viết:
Vậy bạn lấy lại 2 dòng sau. Thế cho 2 dòng ở trên
Mã: 
ColA = 0.08 * Col + 0.19 * Col + 0.62 * Col
ColB = 0.08 * Col & ";" & 0.19 * Col & ";" & 0.62 * Col & ";" & Col - ColA - 4

Rồi test xem có ổn chưa? có ưng í chưa nha.
Nhấp chuột vào đây để mở rộng...
Vẫn chưa được bạn ah.
Mình gửi hình kèm theo nhé!!!
Hoặc bạn có thể hướng dẫn cho mình cách tính các con số trong code sau
(ColA = 0.08 * Col + 0.19 * Col + 0.62 * Col
ColB = 0.08 * Col & ";" & 0.19 * Col & ";" & 0.62 * Col & ";" & Col - ColA - 4)
Vì mình đã thử nhập nhưng mình chưa tìm ra quy tắc các con số lấy từ đâu +-+-+-++-+-+-+​+-+-+-+
Cảm ơn bạn rất nhiều!!!}}}}}
 

File đính kèm

  • hình thay doi độ rộng.jpg
    hình thay doi độ rộng.jpg
    26.2 KB · Đọc: 11
Upvote 0
Mình inbox teamview vào hộp thư bạn rôi, bạn xem giúp mình nhé!
 
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.

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

Q
Không chỉnh sửa, copy được hình ảnh trong file excel. (3 người xem)
Trả lời
6
Đọc
4K
thaivanthao
T
L
Nhờ giúp file word
Trả lời
1
Đọc
72
minhminh27
minhminh27
GPE-Trợ Lý
[GPE] TASKSHOW 14: TỪ BẢNG TÍNH ĐẾN BÁO CÁO ĐỘNG - BẮT ĐẦU VỚI LOOKER STUDIO
    • Thích
Trả lời
1
Đọc
11K
GPE-Trợ Lý
GPE-Trợ Lý
dungluyen2119
  • Question Question
Code VBA để tính tổng theo chiều ngang mà số cột không cố định
Trả lời
5
Đọc
252
dungluyen2119
dungluyen2119
ongke0711
  • Question Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba (2 người xem)
    • Thích
    • Yêu thích
    • Cảm ơn
2 3 4
Trả lời
390
Đọc
46K
phdong
P
8
Theo dõi bán hàng (2 người xem)
Trả lời
10
Đọc
292
84huong
8
L
  • Question Question
Nhờ sửa code ChrW ()
Trả lời
2
Đọc
89
le_vis
L
N
  • Question Question
Hỗ trợ tiếng việt trong macro
Trả lời
12
Đọc
521
Quang_Hải
Quang_Hải
D
xin hỏi về lỗi mô đun ẩn.
Trả lời
6
Đọc
291
du trung kien
D
haohvnh
Lỗi hàm SUM không hiển thị ra kết quả (1 người xem)
Trả lời
19
Đọc
45K
ptm0412
ptm0412
minhduc1o2
Hình ảnh bị lỗi #VALUE
Trả lời
5
Đọc
168
minhduc1o2
minhduc1o2
ongke0711
  • Question Question
Tra cứu thông tin mã số thuế (cập nhật lại code cũ)
    • Thích
    • Cảm ơn
    • Yêu thích
Trả lời
5
Đọc
304
ongke0711
ongke0711
befaint
Chia sẻ tâm tư, xả nỗi lòng (1 người xem)
    • Thích
6 7 8
Trả lời
761
Đọc
61K
SA_DQ
SA_DQ
S
  • Question Question
Object.close và Set Object = nothing
Trả lời
14
Đọc
1K
nguyendang95
N
H
Lỗi khi sort data xin được hỗ trợ
Trả lời
2
Đọc
117
hunglq48
H
Nguyenkhang2404
Tính định mức sản phẩm (1 người xem)
    • Chấp nhận
Trả lời
9
Đọc
370
Nguyenkhang2404
Nguyenkhang2404
T
Ngắt kết nối với tệp lệnh đính kèm
Trả lời
2
Đọc
135
TungXauGiai
T
ongke0711
  • Question Question
Trộn dữ liệu từ Excel sang Word mở rộng (phiên bản ongke0711)
    • Thích
    • Yêu thích
    • Cảm ơn
2 3
Trả lời
277
Đọc
35K
joker102
J
S
tỷ lệ % không khớp khi cộng tổng
Trả lời
2
Đọc
109
snoobcool
S
D
Tên sheet bị che khuất khi thực hiện sửa tên sheet
Trả lời
1
Đọc
272
PhamMaiTB
P
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

Thời gian đếm ngược.

000
Ngày
00
Giờ
00
phút
00
giây
Thân mời tham dự sự kiện sinh nhật GPE 2025
Back
Top Bottom