Xin Giúp Đỡ về vòng lập có điều kiện !

tuantu315 · 16/10/21

Xin chào Anh/Chị Diễn đàn !!
Như tiêu đề trong file e có nêu rõ vấn đề em đang gặp phải mong Anh/Chị Giúp đỡ. Em cám ơn!
Phần đang gặp vấn đề em có mô tả trong file cho dễ mô tả ạ

tuantu315 · 17/10/21

Hy vọng được mọi người giúp đỡ suy nghĩ qua nay chưa có biện pháp giải quyết ạ. Thanks ạ

SA_DQ · 17/10/21

tuantu315 đã viết:
. . . trong file e có nêu rõ vấn đề em đang gặp phải mong Anh/Chị Giúp đỡ. . . .
Phần đang gặp vấn đề em có mô tả trong file cho dễ mô tả ạ

tuantu315 đã viết:
(1). Tên hàng , size , số lượng, thành tiền chuyển qua sheet dulieu (đã làm được)

Bạn viết câu này trên trang có tên là 'DuLieu', mà bạn chỉ có 2 trang tính vậy là chuyển từ trang còn lại
Trang còn lại này có 2 bảng dữ liệu; Nhưng không biết là bạn cần chuyển từ bảng nào sang.
Bảng bên trái thì không phải vì không có 3 mặt hàng. . .
Bảng bên phải là bảng làm mẫu (để coi chơi) mà!

Túm lại, với mình thì chưa hiểu bạn muốn gì, dù bạn có nêu là đã nêu rõ vấn đề; Chuyện này bạn rõ rành, nhưng mọi người chưa rành & rõ để ra tay ra chưn với bạn!

HieuCD · 17/10/21

tuantu315 đã viết:
Xin chào Anh/Chị Diễn đàn !!
Như tiêu đề trong file e có nêu rõ vấn đề em đang gặp phải mong Anh/Chị Giúp đỡ. Em cám ơn!
Phần đang gặp vấn đề em có mô tả trong file cho dễ mô tả ạ

Dựa vào cách viết code của bạn

Mã:

Sub GPE()
  Dim i&, j&, k&, eRow As Long
 
  Application.ScreenUpdating = False
  Sheet6.Range("a12:a42").EntireRow.Hidden = False
  Sheet6.Range("a12:F42").ClearContents
  eRow = Sheet1.[d65000].End(3).Row
  k = 11 ' hàng 12 - 1 sheet6
  For i = 10 To eRow ' hàng 10 sheet1
    k = k + 1
    Sheet6.Cells(k, 6).Value = Sheet1.Cells(i, 3).Value ' ma hang
    Sheet6.Cells(k, 1).Value = Sheet1.Cells(i, 4).Value 'ten hang
    Sheet6.Cells(k, 2).Value = Sheet1.Cells(i, 6).Value ' sl
    Sheet6.Cells(k, 3).Value = Sheet1.Cells(i, 7).Value '  don gia
    Sheet6.Cells(k, 4).Value = Sheet1.Cells(i, 14).Value ' thanh tien
    For j = 8 To 11 Step 3
      If Sheet1.Cells(i, j).Value <> Empty Then
        k = k + 1
        Sheet6.Cells(k, 1).Value = Sheet1.Cells(i, j).Value 'ten hang
        Sheet6.Cells(k, 2).Value = Sheet1.Cells(i, j + 1).Value ' sl
        Sheet6.Cells(k, 3).Value = Sheet1.Cells(i, j + 2).Value '  don gia
      End If
    Next j
  Next i
  Sheet6.Range("A12:A42").EntireRow.AutoFit
  Sheet6.Range("a12:a42").SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True
  Application.ScreenUpdating = True
End Sub

tuantu315 · 17/10/21

SA_DQ đã viết:
Bạn viết câu này trên trang có tên là 'DuLieu', mà bạn chỉ có 2 trang tính vậy là chuyển từ trang còn lại
Trang còn lại này có 2 bảng dữ liệu; Nhưng không biết là bạn cần chuyển từ bảng nào sang.
Bảng bên trái thì không phải vì không có 3 mặt hàng. . .
Bảng bên phải là bảng làm mẫu (để coi chơi) mà!

Túm lại, với mình thì chưa hiểu bạn muốn gì, dù bạn có nêu là đã nêu rõ vấn đề; Chuyện này bạn rõ rành, nhưng mọi người chưa rành & rõ để ra tay ra chưn với bạn!

Ôi chết em nhầm đúng là phải sheet dulieu chuyen sheet hoadon ạ. Mong anh giúp em ạ

Bài đã được tự động gộp: 17/10/21

HieuCD đã viết:

Dựa vào cách viết code của bạn

Mã:

Sub GPE()
  Dim i&, j&, k&, eRow As Long
 
  Application.ScreenUpdating = False
  Sheet6.Range("a12:a42").EntireRow.Hidden = False
  Sheet6.Range("a12:F42").ClearContents
  eRow = Sheet1.[d65000].End(3).Row
  k = 11 ' hàng 12 - 1 sheet6
  For i = 10 To eRow ' hàng 10 sheet1
    k = k + 1
    Sheet6.Cells(k, 6).Value = Sheet1.Cells(i, 3).Value ' ma hang
    Sheet6.Cells(k, 1).Value = Sheet1.Cells(i, 4).Value 'ten hang
    Sheet6.Cells(k, 2).Value = Sheet1.Cells(i, 6).Value ' sl
    Sheet6.Cells(k, 3).Value = Sheet1.Cells(i, 7).Value '  don gia
    Sheet6.Cells(k, 4).Value = Sheet1.Cells(i, 14).Value ' thanh tien
    For j = 8 To 11 Step 3
      If Sheet1.Cells(i, j).Value <> Empty Then
        k = k + 1
        Sheet6.Cells(k, 1).Value = Sheet1.Cells(i, j).Value 'ten hang
        Sheet6.Cells(k, 2).Value = Sheet1.Cells(i, j + 1).Value ' sl
        Sheet6.Cells(k, 3).Value = Sheet1.Cells(i, j + 2).Value '  don gia
      End If
    Next j
  Next i
  Sheet6.Range("A12:A42").EntireRow.AutoFit
  Sheet6.Range("a12:a42").SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True
  Application.ScreenUpdating = True
End Sub

Quá hay anh ơi gãi đúng chỗ ngứa .. Thanks anh nhiều
Hôm qua đến giờ em suy nghĩ hoài xong xài code này nó chậm dã man
For Each cell In Sheet1.Range("h10:h40")
' If cell.Value = "" Then
....
else
....

HUONGHCKT · 17/10/21

tuantu315 đã viết:
Xin chào Anh/Chị Diễn đàn !!
Như tiêu đề trong file e có nêu rõ vấn đề em đang gặp phải mong Anh/Chị Giúp đỡ. Em cám ơn!
Phần đang gặp vấn đề em có mô tả trong file cho dễ mô tả ạ

Nếu vẫn còn quan tâm và hứng thú vói VBA thì thử code này xem sao.
Vẫn code của bạn tôi sửa lại thêm chút mắm, muối nữa thôi.
Thay Code trong modul Sub ghihoadon bằng Code này và chạy thử.

Mã:

Sub ghihoadon()
Dim I As Long, J As Long, K As Long, eRow As Long, C&, t&
Dim Arr(), KQ()
Sheet6.Range("a12:a44").EntireRow.Hidden = False
Sheet6.Range("a12:F46").ClearContents
eRow = Sheet1.Cells(Rows.Count, 4).End(xlUp).Row
Arr = Sheet1.Range("C10:N" & eRow).Value
K = UBound(Arr, 1): C = UBound(Arr, 2)
ReDim KQ(1 To K + 100, 1 To 7)
For I = 1 To K
t = t + 1
    KQ(t, 1) = t
    For J = 1 To 5
            KQ(t, J + 1) = Arr(I, J)
    Next J
        KQ(t, 7) = Arr(I, 12)
        If Arr(I, 6) <> Empty Then
            t = t + 1
                 KQ(t, 1) = t:                 KQ(t, 3) = Arr(I, 6)
                 KQ(t, 5) = Arr(I, 7):         KQ(t, 6) = Arr(I, 8)
        End If
       If Arr(I, 9) <> Empty Then
            t = t + 1
                 KQ(t, 1) = t:                 KQ(t, 3) = Arr(I, 9)
                 KQ(t, 5) = Arr(I, 10):        KQ(t, 6) = Arr(I, 11)
        End If
Next I
Sheet6.[A12].Resize(t, 7) = KQ
Sheet6.Range("A12:A46").EntireRow.AutoFit
Sheet6.Range("a12:a46").SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True
Application.ScreenUpdating = True
MsgBox " XONG"
End Sub

tuantu315 · 17/10/21

HUONGHCKT đã viết:

Nếu vẫn còn quan tâm và hứng thú vói VBA thì thử code này xem sao.
Vẫn code của bạn tôi sửa lại thêm chút mắm, muối nữa thôi.
Thay Code trong modul Sub ghihoadon bằng Code này và chạy thử.

Mã:

Sub ghihoadon()
Dim I As Long, J As Long, K As Long, eRow As Long, C&, t&
Dim Arr(), KQ()
Sheet6.Range("a12:a44").EntireRow.Hidden = False
Sheet6.Range("a12:F46").ClearContents
eRow = Sheet1.Cells(Rows.Count, 4).End(xlUp).Row
Arr = Sheet1.Range("C10:N" & eRow).Value
K = UBound(Arr, 1): C = UBound(Arr, 2)
ReDim KQ(1 To K + 100, 1 To 7)
For I = 1 To K
t = t + 1
    KQ(t, 1) = t
    For J = 1 To 5
            KQ(t, J + 1) = Arr(I, J)
    Next J
        KQ(t, 7) = Arr(I, 12)
        If Arr(I, 6) <> Empty Then
            t = t + 1
                 KQ(t, 1) = t:                 KQ(t, 3) = Arr(I, 6)
                 KQ(t, 5) = Arr(I, 7):         KQ(t, 6) = Arr(I, 8)
        End If
       If Arr(I, 9) <> Empty Then
            t = t + 1
                 KQ(t, 1) = t:                 KQ(t, 3) = Arr(I, 9)
                 KQ(t, 5) = Arr(I, 10):        KQ(t, 6) = Arr(I, 11)
        End If
Next I
Sheet6.[A12].Resize(t, 7) = KQ
Sheet6.Range("A12:A46").EntireRow.AutoFit
Sheet6.Range("a12:a46").SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True
Application.ScreenUpdating = True
MsgBox " XONG"
End Sub

Thanks bạn ạ. Bạn xài mảng cũng quá hay nhanh gọn !! nhưng mà mình không lấy hết tất cả các cột mình chỉ chọn cột D,F,G,N sheet 1 thôi

HieuCD · 17/10/21

HUONGHCKT đã viết:

Nếu vẫn còn quan tâm và hứng thú vói VBA thì thử code này xem sao.
Vẫn code của bạn tôi sửa lại thêm chút mắm, muối nữa thôi.
Thay Code trong modul Sub ghihoadon bằng Code này và chạy thử.

Mã:

Sub ghihoadon()
Dim I As Long, J As Long, K As Long, eRow As Long, C&, t&
Dim Arr(), KQ()
Sheet6.Range("a12:a44").EntireRow.Hidden = False
Sheet6.Range("a12:F46").ClearContents
eRow = Sheet1.Cells(Rows.Count, 4).End(xlUp).Row
Arr = Sheet1.Range("C10:N" & eRow).Value
K = UBound(Arr, 1): C = UBound(Arr, 2)
ReDim KQ(1 To K + 100, 1 To 7)
For I = 1 To K
t = t + 1
    KQ(t, 1) = t
    For J = 1 To 5
            KQ(t, J + 1) = Arr(I, J)
    Next J
        KQ(t, 7) = Arr(I, 12)
        If Arr(I, 6) <> Empty Then
            t = t + 1
                 KQ(t, 1) = t:                 KQ(t, 3) = Arr(I, 6)
                 KQ(t, 5) = Arr(I, 7):         KQ(t, 6) = Arr(I, 8)
        End If
       If Arr(I, 9) <> Empty Then
            t = t + 1
                 KQ(t, 1) = t:                 KQ(t, 3) = Arr(I, 9)
                 KQ(t, 5) = Arr(I, 10):        KQ(t, 6) = Arr(I, 11)
        End If
Next I
Sheet6.[A12].Resize(t, 7) = KQ
Sheet6.Range("A12:A46").EntireRow.AutoFit
Sheet6.Range("a12:a46").SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True
Application.ScreenUpdating = True
MsgBox " XONG"
End Sub

Đoạn nầy giống nhau, dùng For rút gọn lại

Mã:

        If Arr(I, 6) <> Empty Then
            t = t + 1
                 KQ(t, 1) = t:                 KQ(t, 3) = Arr(I, 6)
                 KQ(t, 5) = Arr(I, 7):         KQ(t, 6) = Arr(I, 8)
        End If
       If Arr(I, 9) <> Empty Then
            t = t + 1
                 KQ(t, 1) = t:                 KQ(t, 3) = Arr(I, 9)
                 KQ(t, 5) = Arr(I, 10):        KQ(t, 6) = Arr(I, 11)
        End If

HUONGHCKT · 17/10/21

HieuCD đã viết:

Đoạn nầy giống nhau, dùng For rút gọn lại

Mã:

        If Arr(I, 6) <> Empty Then
            t = t + 1
                 KQ(t, 1) = t:                 KQ(t, 3) = Arr(I, 6)
                 KQ(t, 5) = Arr(I, 7):         KQ(t, 6) = Arr(I, 8)
        End If
       If Arr(I, 9) <> Empty Then
            t = t + 1
                 KQ(t, 1) = t:                 KQ(t, 3) = Arr(I, 9)
                 KQ(t, 5) = Arr(I, 10):        KQ(t, 6) = Arr(I, 11)
        End If

Cảm ơn anh đã ghé xem bài. Chỗ đó tôi loanh quanh mãi mà không biết làm thế nào.
tôi đã ấn nó vào một vòng lặp
for j=6 to C
If Arr(i,6)<>empty or Arr(i,9) <> empty then
t=t+1
KQ(t,3)=Arr(i,6) ; Cái chỗ này làm cả cho Arr(i,9) nữa đã làm khó tôi.
KQ((t,5) =Arr(i,j+1)
next J
Làm mãi mà không biết cách gì để xử lý dòng vấn đề chỗ dòng bôi đậm đó, đành viết dài ra như vậy đó. Nếu có thể Anh @HieuCD và các anh chị em khác ghé qua cho tôi một hướng giải quyết để có thêm kinh nghiệm nhé.
Gọn lại thì cũng được nhưng để như cũ thì cũng dễ xem mà.

Bài đã được tự động gộp: 17/10/21

tuantu315 đã viết:
Thanks bạn ạ. Bạn xài mảng cũng quá hay nhanh gọn !! nhưng mà mình không lấy hết tất cả các cột mình chỉ chọn cột D,F,G,N sheet 1 thôi

Bạn tự sửa được chứ?
Tôi thấy trình tự làm là từ Hóa đơn vào 1 sh nào đó (có thể là DATA, hoặc TONGHOP, hoặc DAXUAT, DANHAP....) chứ từ DATA... sang HOADON thì chỉ để xem lại, thêm bớt, xóa, sửa thôi. tất nhiên quy trình làm việc là của bạn, miễn là nó thuận tiện cho mình

tuantu315 · 17/10/21

HUONGHCKT đã viết:
Cảm ơn anh đã ghé xem bài. Chỗ đó tôi loanh quanh mãi mà không biết làm thế nào.
tôi đã ấn nó vào một vòng lặp
for j=6 to C
If Arr(i,6)<>empty or Arr(i,9) <> empty then
t=t+1
KQ(t,3)=Arr(i,6) ; Cái chỗ này làm cả cho Arr(i,9) nữa đã làm khó tôi.
KQ((t,5) =Arr(i,j+1)
next J
Làm mãi mà không biết cách gì để xử lý dòng vấn đề chỗ dòng bôi đậm đó, đành viết dài ra như vậy đó. Nếu có thể Anh @HieuCD và các anh chị em khác ghé qua cho tôi một hướng giải quyết để có thêm kinh nghiệm nhé.
Gọn lại thì cũng được nhưng để như cũ thì cũng dễ xem mà.

Bài đã được tự động gộp: 17/10/21

Bạn tự sửa được chứ?
Tôi thấy trình tự làm là từ Hóa đơn vào 1 sh nào đó (có thể là DATA, hoặc TONGHOP, hoặc DAXUAT, DANHAP....) chứ từ DATA... sang HOADON thì chỉ để xem lại, thêm bớt, xóa, sửa thôi. tất nhiên quy trình làm việc là của bạn, miễn là nó thuận tiện cho mình

Thanks bạn nhiều. Vấn đề sắp sếp dữ liệu ổn rồi ạ chỉ bị khúc mắc phần nhỏ đó thôi. Cám ơn bạn nhiệt tình giúp đỡ

Maika8008 · 17/10/21

HUONGHCKT đã viết:
Cảm ơn anh đã ghé xem bài. Chỗ đó tôi loanh quanh mãi mà không biết làm thế nào.
tôi đã ấn nó vào một vòng lặp
for j=6 to C
If Arr(i,6)<>empty or Arr(i,9) <> empty then
t=t+1
KQ(t,3)=Arr(i,6) ; Cái chỗ này làm cả cho Arr(i,9) nữa đã làm khó tôi.
KQ((t,5) =Arr(i,j+1)
next J
Làm mãi mà không biết cách gì để xử lý dòng vấn đề chỗ dòng bôi đậm đó, đành viết dài ra như vậy đó. Nếu có thể Anh @HieuCD và các anh chị em khác ghé qua cho tôi một hướng giải quyết để có thêm kinh nghiệm nhé.

Chỗ đó chắc là làm thế này:

Rich (BB code):

 Dim cot&
 For cot = 6 to 9 step 3
     If Arr(I, cot) <> Empty Then
        t = t + 1
        KQ(t, 1) = t:                 KQ(t, 3) = Arr(I, cot)
        KQ(t, 5) = Arr(I, cot + 1):   KQ(t, 6) = Arr(I, cot + 2)
    End If
Next

HUONGHCKT · 17/10/21

Maika8008 đã viết:
Chỗ đó chắc là làm thế này:

Rich (BB code):

Dim cot& For cot = 6 to 9 step 3 If Arr(I, cot) <> Empty Then t = t + 1 KQ(t, 1) = t: KQ(t, 3) = Arr(I, cot) KQ(t, 5) = Arr(I, cot + 1): KQ(t, 6) = Arr(I, cot + 2) End If Next

Tuyệt vời! Thế mà tôi nghĩ mãi không ra, cứ loanh quanh Cot=t+1 rồi if J=6 then.... và if j=9 then.... mà vẫn cứ không ra rồi lại không ra.... Cảm ơn anh đã cho tôi thêm kinh nghiệm về viết Code và giải thuật để giải các bài tương tự. Trân trọng

Xin Giúp Đỡ về vòng lập có điều kiện !

tuantu315

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

File đính kèm

tuantu315

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

SA_DQ

/(hông là gì!

HieuCD

Chuyên gia GPE

tuantu315

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

File đính kèm

HUONGHCKT

Zalo 0986997214

File đính kèm

tuantu315

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

HieuCD

Chuyên gia GPE

HUONGHCKT

Zalo 0986997214

tuantu315

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

Maika8008

Thành viên gạo cội

HUONGHCKT

Zalo 0986997214

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

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