Thu gọn lại bảng tính cho dễ nhìn

moihocvba · 8/1/21

E đang gặp thử thách như này, nhờ mấy anh chị giúp với.

E có bảng nhập hàng như này:

Tên hàng bị trùng khá nhiều, chỉ khác diễn giải nên em muốn thu gọn lại như bảng dưới để dễ nhìn, khỏi bị rối với lại kiểm hàng cho nhanh.

Có khoảng 30 mã hàng mỗi lần như vậy mà tên hàng trùng nhiều quá, mong mấy anh chị giúp em một code để làm việc này. em xin cảm ơn ạ!

befaint · 8/1/21

moihocvba đã viết:
diễn dãi

Diễn giải mới đúng chính tả tiếng Việt.

Dùng cột phụ =countif($a2:a2,a2)>1
Lọc cột phụ lấy TRUE, chọn vùng lọc, nhấn alt ; rồi nhấn delete.
Bỏ lọc là xong.

moihocvba · 8/1/21

befaint đã viết:
Diễn giải mới đúng chính tả tiếng Việt.

Dùng cột phụ =countif($a2:a2,a2)>1
Lọc cột phụ lấy TRUE, chọn vùng lọc, nhấn alt ; rồi nhấn delete.
Bỏ lọc là xong.

Cám ơn a. Vấn đề là em nhập liệu ở 1 sheet, đến khi in em mới đưa vào mảng xử lý và dán vào sheet in. E đang suy nghĩ ko biết đưa vào mảng rồi xử lý sao. A có thể cho em gợi ý thuật toán đc ko?

SA_DQ · 8/1/21

Bạn thử với con này & chú ý:
Tên trang tính sửa lại cho đúng với tên hiện có của bạn
Dữ liệu đã được sắp xếp như file của bạn ở #1
Sửa lại dòng lệnh hiện kết quả

PHP:

Sub XepBang()
 Dim Rws As Long, J As Long, W As Long, Col As Integer
 Dim TenHg As String
 
 Sheets("DuLieu").Select
 Rws = [B2].CurrentRegion.Rows.Count
 ReDim Arr(1 To 2 * Rws, 1 To 5)
 For J = 2 To Rws
    W = W + 1
    If TenHg <> Cells(J, "A").Value Then
        TenHg = Cells(J, "A").Value
        Arr(W, 1) = TenHg
         W = W + 1
    End If
    For Col = 1 To 5
        Arr(W, Col) = Space(9) & Cells(J, 1 + Col).Value
    Next Col
Next J
 Sheets("KQua").[A12].Resize(W, 5).Value = Arr()
End Sub

be_09 · 9/1/21

moihocvba đã viết:
E đang gặp thử thách như này, nhờ mấy anh chị giúp với.

E có bảng nhập hàng như này:
View attachment 252654

Tên hàng bị trùng khá nhiều, chỉ khác diễn dãi nên em muốn thu gọn lại như bảng dưới để dễ nhìn, khỏi bị rối với lại kiểm hàng cho nhanh.

View attachment 252657

Có khoảng 30 mã hàng mỗi lần như vậy mà tên hàng trùng nhiều quá, mong mấy anh chị giúp em một code để làm việc này. em xin cảm ơn ạ!

Không ai làm ngược đời như bạn, theo dõi như hình 1 là cách tốt nhất, sau đó sử dụng PivotTable để được kết quả như hình 2.

SA_DQ · 9/1/21

Chủ bài đăng thân mến: Bạn có thể tạo mã duy nhất cho các loại SF như:

Mã SF

HFD21_A

HFD21_B

HFD21_C

HSD42_D

HSD42_E

Lúc đó thì tổng hợp kiểu gì cũng như trở bàn tay!
Chúc vui nha!

moihocvba · 9/1/21

SA_DQ đã viết:
Bạn thử với con này & chú ý:
Tên trang tính sửa lại cho đúng với tên hiện có của bạn
Dữ liệu đã được sắp xếp như file của bạn ở #1
Sửa lại dòng lệnh hiện kết quả

PHP:

Sub XepBang() Dim Rws As Long, J As Long, W As Long, Col As Integer Dim TenHg As String Sheets("DuLieu").Select Rws = [B2].CurrentRegion.Rows.Count ReDim Arr(1 To 2 * Rws, 1 To 5) For J = 2 To Rws W = W + 1 If TenHg <> Cells(J, "A").Value Then TenHg = Cells(J, "A").Value Arr(W, 1) = TenHg W = W + 1 End If For Col = 1 To 5 Arr(W, Col) = Space(9) & Cells(J, 1 + Col).Value Next Col Next J Sheets("KQua").[A12].Resize(W, 5).Value = Arr() End Sub

Cảm ơn anh rất nhiều. Code chạy ra kết quả giống như em mong muốn. E đang tập phân tích code của anh để hiểu thêm.

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

SA_DQ đã viết:
Chủ bài đăng thân mến: Bạn có thể tạo mã duy nhất cho các loại SF như:

Mã SF
HFD21_A
HFD21_B
HFD21_C
HSD42_D
HSD42_E

Lúc đó thì tổng hợp kiểu gì cũng như trở bàn tay!
Chúc vui nha!

Bản thân tên hàng cũng là duy nhất rồi đó anh, em cố tính tạo tên hàng ko trùng nhau rồi. 1 tên hàng có rất nhiều quy cách thay đổi liên tục tên ko thể khai báo chi tiết được.

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

be09 đã viết:
Không ai làm ngược đời như bạn, theo dõi như hình 1 là cách tốt nhất, sau đó sử dụng PivotTable để được kết quả như hình 2.

Do nhu cầu thì em mới làm chứ cũng ko muốn tạo khó cho mình anh ạ. Còn Pivot thì ko được, vì em cần copy qua sheet khác để in đó anh. Mà muốn kiểu bấm nút thì nó tự in chứ ko copy thủ công. Cám ơn anh đã tư vấn nhé!

SA_DQ · 9/1/21

Bản thân tên hàng cũng là duy nhất rồi đó anh, em cố tính tạo tên hàng ko trùng nhau rồi. 1 tên hàng có rất nhiều quy cách thay đổi liên tục tên ko thể khai báo chi tiết được.

Có mã HH thì tránh sai sót chính tả khi nhập liệu, tìm kiếm sẽ nhanh (khi mã HH có khoa học nhiều thì nhanh hơn)
Nếu nhiều HH trong kho của cửa hàng thì Mã tiếp tục chia nhóm để tìm cho nhanh

be_09 · 9/1/21

moihocvba đã viết:
Cảm ơn anh rất nhiều. Code chạy ra kết quả giống như em mong muốn. E đang tập phân tích code của anh để hiểu thêm.

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

Bản thân tên hàng cũng là duy nhất rồi đó anh, em cố tính tạo tên hàng ko trùng nhau rồi. 1 tên hàng có rất nhiều quy cách thay đổi liên tục tên ko thể khai báo chi tiết được.

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

Do nhu cầu thì em mới làm chứ cũng ko muốn tạo khó cho mình anh ạ. Còn Pivot thì ko được, vì em cần copy qua sheet khác để in đó anh. Mà muốn kiểu bấm nút thì nó tự in chứ ko copy thủ công. Cám ơn anh đã tư vấn nhé!

Code vẫn làm được điều bạn mong muốn.

moihocvba · 9/1/21

SA_DQ đã viết:
Có mã HH thì tránh sai sót chính tả khi nhập liệu, tìm kiếm sẽ nhanh (khi mã HH có khoa học nhiều thì nhanh hơn)
Nếu nhiều HH trong kho của cửa hàng thì Mã tiếp tục chia nhóm để tìm cho nhanh

Cám ơn anh đã tư vấn. Anh cho em hỏi thêm 1 vấn đề nữa. Ngoài bán tôn thì em có bán thêm phụ tùng, nhưng phụ tùng thì chỉ mỗi duy nhất 1 dòng ko có cột Diễn giải (quy cách), vậy mình sửa code làm sao để nó ra kết quả như bên dưới anh? Cám ơn anh!

Trước:

Sau:

DarkWanderer · 9/1/21

Em cũng hay làm như trên để tạo Báo cáo NXT, em có 2 sheet
- sheet1 chứa các mã Hàng Hóa
- sheet2 chứa các mã Lô hàng
Hai sheet liên kết với nhau bằng cột ghép mã giữa Mã Kho và Mã Hàng.
Khi cần tạo NXT về các mặt hàng còn tồn kho, em sẽ add các Lô hàng trong sheet2 có tồn kho >0 vào Dictionary, sau đó tìm kiếm các Mã Hàng bên sheet1 có tồn tại trong Dictionary. Tất cả kết quả đưa vào 1 mảng rồi đưa ra mẫu file Báo cáo

moihocvba · 9/1/21

SA_DQ đã viết:
Bạn thử với con này & chú ý:
Tên trang tính sửa lại cho đúng với tên hiện có của bạn
Dữ liệu đã được sắp xếp như file của bạn ở #1
Sửa lại dòng lệnh hiện kết quả

PHP:

Sub XepBang() Dim Rws As Long, J As Long, W As Long, Col As Integer Dim TenHg As String Sheets("DuLieu").Select Rws = [B2].CurrentRegion.Rows.Count ReDim Arr(1 To 2 * Rws, 1 To 5) For J = 2 To Rws W = W + 1 If TenHg <> Cells(J, "A").Value Then TenHg = Cells(J, "A").Value Arr(W, 1) = TenHg W = W + 1 End If For Col = 1 To 5 Arr(W, Col) = Space(9) & Cells(J, 1 + Col).Value Next Col Next J Sheets("KQua").[A12].Resize(W, 5).Value = Arr() End Sub

Sau khi tham khảo ý kiến của anh em thì em nghĩ nên làm kiểu này sẽ dễ nhìn hơn:

Trước:

Sau:

Có nghĩa cùng 1 tên hàng em sẽ cộng tổng số lượng vs thành tiền lại thành 1 dòng ứng vs tên hàng đó. Vậy em nên sửa code lại như thế nào ạ? Mong chỉ giúp 1 lần nữa! cám ơn nhiều ạ!

SA_DQ · 9/1/21

Tạm thời là vầy:

PHP:

Sub XepBang()
 Dim Rws As Long, J As Long, W As Long, Col As Integer, SoLg As Double, DgTong As Long, DGia As Double
 Dim TenHg As String
 
 Sheets("DuLieu").Select
 Rws = [B2].CurrentRegion.Rows.Count
 ReDim Arr(1 To 2 * Rws, 1 To 5)
 For J = 2 To Rws
    W = W + 1
    If TenHg <> Cells(J, "A").Value Then
        TenHg = Cells(J, "A").Value
        Arr(W, 1) = TenHg
        If Cells(J, "B").Value = "" Then                'Fu Tùng   '
            Arr(DgTong, 2) = SoLg:                  Arr(DgTong, 5) = Arr(DgTong, 2) * Arr(DgTong, 4)
            SoLg = 0
            Arr(W, 1) = Space(3) & Arr(W, 1)        'Tên Fu Tùng    '
            SoLg = Cells(J, "C").Value
            Arr(W, 2) = SoLg:                       Arr(W, 3) = Cells(J, "D").Value
            Arr(J, 4) = Cells(J, "E").Value:        Arr(W, 5) = Arr(W, 2) * Arr(W, 4)
        Else
            If DgTong > 0 Then
                Arr(DgTong, 2) = SoLg
                Arr(DgTong, 5) = Arr(DgTong, 2) * Arr(DgTong, 4)
            End If
            
            SoLg = Cells(J, "C").Value:             Arr(W, 4) = Cells(J, "e").Value
            Arr(W, 3) = Cells(J, "d").Value         'Don Vi Tính    '
        End If
        DgTong = W
        If Cells(J, "B").Value <> "" Then
            W = W + 1
            Arr(W, 1) = Space(9) & Cells(J, 2)
        End If
    Else
        Arr(W, 1) = Space(9) & Cells(J, 2)
        SoLg = SoLg + Cells(J, "C").Value
    End If
 
Next J
 Sheets("KQua").[A12].Resize(W, 5).Value = Arr()
End Sub

moihocvba · 10/1/21

SA_DQ đã viết:

Tạm thời là vầy:

PHP:

Sub XepBang()
Dim Rws As Long, J As Long, W As Long, Col As Integer, SoLg As Double, DgTong As Long, DGia As Double
Dim TenHg As String

Sheets("DuLieu").Select
Rws = [B2].CurrentRegion.Rows.Count
ReDim Arr(1 To 2 * Rws, 1 To 5)
For J = 2 To Rws
    W = W + 1
    If TenHg <> Cells(J, "A").Value Then
        TenHg = Cells(J, "A").Value
        Arr(W, 1) = TenHg
        If Cells(J, "B").Value = "" Then                'Fu Tùng   '
            Arr(DgTong, 2) = SoLg:                  Arr(DgTong, 5) = Arr(DgTong, 2) * Arr(DgTong, 4)
            SoLg = 0
            Arr(W, 1) = Space(3) & Arr(W, 1)        'Tên Fu Tùng    '
            SoLg = Cells(J, "C").Value
            Arr(W, 2) = SoLg:                       Arr(W, 3) = Cells(J, "D").Value
            Arr(J, 4) = Cells(J, "E").Value:        Arr(W, 5) = Arr(W, 2) * Arr(W, 4)
        Else
            If DgTong > 0 Then
                Arr(DgTong, 2) = SoLg
                Arr(DgTong, 5) = Arr(DgTong, 2) * Arr(DgTong, 4)
            End If
           
            SoLg = Cells(J, "C").Value:             Arr(W, 4) = Cells(J, "e").Value
            Arr(W, 3) = Cells(J, "d").Value         'Don Vi Tính    '
        End If
        DgTong = W
        If Cells(J, "B").Value <> "" Then
            W = W + 1
            Arr(W, 1) = Space(9) & Cells(J, 2)
        End If
    Else
        Arr(W, 1) = Space(9) & Cells(J, 2)
        SoLg = SoLg + Cells(J, "C").Value
    End If

Next J
Sheets("KQua").[A12].Resize(W, 5).Value = Arr()
End Sub

Sau khi em chạy code thì nó ra kết quả như này, anh giúp em chỉnh lại chút nhé SA_DQ !
'Dòng đơn giá của mã phụ tùng bị lệch và thành tiền của nó bằng 0.'
Cám ơn anh lần nữa!

Ba Tê · 10/1/21

moihocvba đã viết:
Sau khi em chạy code thì nó ra kết quả như này, anh giúp em chỉnh lại chút nhé @SA_DQ !
'Dòng đơn giá của mã phụ tùng bị lệch và thành tiền của nó bằng 0.'
Cám ơn anh lần nữa!

Dùng cho file bài #1.

PHP:

Public Sub Gpe()
Dim sArr(), dArr(), I As Long, J As Long, K As Long, R As Long, Rws As Long, TenHang As String
    sArr = Sheet4.Range("A2", Sheet4.Range("A10000").End(xlUp)).Resize(, 6).Value
    R = UBound(sArr)
ReDim dArr(1 To R * 2, 1 To 5)
    For I = 1 To R
        If sArr(I, 1) <> TenHang Then
            K = K + 1
            dArr(K, 1) = sArr(I, 1)
            For J = 2 To 5
                dArr(K, J) = sArr(I, J + 1)
            Next J
            Rws = K
            TenHang = sArr(I, 1)
            If sArr(I, 2) <> Empty Then
                K = K + 1
                dArr(K, 1) = sArr(I, 2)
            End If
        Else
            K = K + 1
            dArr(K, 1) = sArr(I, 2)
            dArr(Rws, 2) = dArr(Rws, 2) + sArr(I, 3)
            dArr(Rws, 5) = dArr(Rws, 5) + sArr(I, 6)
        End If
    Next I
Sheet1.Range("A2").Resize(10000, 5).ClearContents
Sheet1.Range("A2").Resize(K, 5) = dArr
End Sub

moihocvba · 10/1/21

Ba Tê đã viết:

Dùng cho file bài #1.

PHP:

Public Sub Gpe()
Dim sArr(), dArr(), I As Long, J As Long, K As Long, R As Long, Rws As Long, TenHang As String
    sArr = Sheet4.Range("A2", Sheet4.Range("A10000").End(xlUp)).Resize(, 6).Value
    R = UBound(sArr)
ReDim dArr(1 To R * 2, 1 To 5)
    For I = 1 To R
        If sArr(I, 1) <> TenHang Then
            K = K + 1
            dArr(K, 1) = sArr(I, 1)
            For J = 2 To 5
                dArr(K, J) = sArr(I, J + 1)
            Next J
            Rws = K
            TenHang = sArr(I, 1)
            If sArr(I, 2) <> Empty Then
                K = K + 1
                dArr(K, 1) = sArr(I, 2)
            End If
        Else
            K = K + 1
            dArr(K, 1) = sArr(I, 2)
            dArr(Rws, 2) = dArr(Rws, 2) + sArr(I, 3)
            dArr(Rws, 5) = dArr(Rws, 5) + sArr(I, 6)
        End If
    Next I
Sheet1.Range("A2").Resize(10000, 5).ClearContents
Sheet1.Range("A2").Resize(K, 5) = dArr
End Sub

Quá chuẩn luôn anh Ba Tê ơi. Cám ơn anh rất nhiều luôn. Mừng rớt nước mắt

Thu gọn lại bảng tính cho dễ nhìn

moihocvba

Thành viên thường trực

File đính kèm

befaint

|||||||||||||

moihocvba

Thành viên thường trực

SA_DQ

/(hông là gì!

be_09

Biên Hòa, Đồng Nai

SA_DQ

/(hông là gì!

moihocvba

Thành viên thường trực

SA_DQ

/(hông là gì!

be_09

Biên Hòa, Đồng Nai

moihocvba

Thành viên thường trực

DarkWanderer

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

moihocvba

Thành viên thường trực

SA_DQ

/(hông là gì!

moihocvba

Thành viên thường trực

Ba Tê

Cạo Rồi Khỏi Gội

moihocvba

Thành viên thường trực

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