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

Blue Softs epl Liên hệ QC

tuantu315

Thành viên hoạt động
Tham gia
30/9/13
Bài viết
141
Được thích
38
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ả ạ
 

File đính kèm

  • GPE.xlsm
    101.8 KB · Đọc: 3
Lần chỉnh sửa cuối:

tuantu315

Thành viên hoạt động
Tham gia
30/9/13
Bài viết
141
Được thích
38
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 ạ
 
Upvote 0

SA_DQ

/(hông là gì!
Thành viên danh dự
Tham gia
8/6/06
Bài viết
12,766
Được thích
19,497
. . . 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ả ạ

(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!
 
Upvote 0

HieuCD

Chuyên gia GPE
Tham gia
14/9/10
Bài viết
8,566
Được thích
18,145
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
 
Upvote 0

tuantu315

Thành viên hoạt động
Tham gia
30/9/13
Bài viết
141
Được thích
38
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:

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
....
 

File đính kèm

  • GPE.xlsm
    101.8 KB · Đọc: 0
Lần chỉnh sửa cuối:
Upvote 0

HUONGHCKT

Thành viên tiêu biểu
Tham gia
30/8/12
Bài viết
538
Được thích
735
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
 

File đính kèm

  • GPE (3).xlsm
    28.4 KB · Đọc: 4
Upvote 0

tuantu315

Thành viên hoạt động
Tham gia
30/9/13
Bài viết
141
Được thích
38
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
 
Upvote 0

HieuCD

Chuyên gia GPE
Tham gia
14/9/10
Bài viết
8,566
Được thích
18,145
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
 
Upvote 0

HUONGHCKT

Thành viên tiêu biểu
Tham gia
30/8/12
Bài viết
538
Được thích
735
Đ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:

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
 
Lần chỉnh sửa cuối:
Upvote 0

tuantu315

Thành viên hoạt động
Tham gia
30/9/13
Bài viết
141
Được thích
38
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:


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 đỡ
 
Upvote 0

Maika8008

Thành viên gắn bó
Tham gia
12/6/20
Bài viết
2,685
Được thích
2,972
Donate (Momo)
Donate
Giới tính
Nam
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
 
Upvote 0

HUONGHCKT

Thành viên tiêu biểu
Tham gia
30/8/12
Bài viết
538
Được thích
735
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
 
Upvote 0
Web KT
Top Bottom