Chuyển đổi và phân tách dữ liệu

vanvan9697

Thành viên chính thức
Tham gia ngày
11 Tháng năm 2012
Bài viết
68
Thích
5
Điểm
370
Tuổi
40
#1
Em có 1 bảng dữ liệu khai báo nội dung quy chuyển đổi với điều kiện
+ Nếu Đơn vị tính Khai báo nội dung trùng với cột đơn vị tính Khai báo thông tin chuyển bên sheet KhaiBao thì
Mã vật tư và quy cách bên sheet KhaiBao khớp với cột I và J bên sheet data thì Cột số lượng (L) được nhân theo tỉ lệ % ( định dạng theo %) đã khai báo bên sheet KhaiBao( cột G). Còn cột số tiền mua được chia theo số lượng mã được khai báo ví dụ mã HB0001 được chuyển thành 2 mã HH0001 và HH0002 thì giá mua sẽ được chia 2. Còn nếu chia làm 4 mã thì sẽ chia 4.
+ Nếu Đơn vị tính Khai báo nội dung không trùng với cột đơn vị tính Khai báo thông tin chuyển bên sheet KhaiBao thì
Mã vật tư và quy cách bên sheet KhaiBao khớp với cột I và J bên sheet data thì Cột số lượng (L) được nhân theo tỉ lệ (định là là number) đã khai báo bên sheet KhaiBao( cột G). Còn cột số tiền mua được chia theo tỷ lệ ( định dạng là number bên sheet khaibao).
Anh ( Chị ) giúp em đoạn Sub với ạ !. Em cảm ơn Anh (chị ) ạ
 

File đính kèm

HieuCD

Thành viên gạo cội
Tham gia ngày
14 Tháng chín 2010
Bài viết
5,040
Thích
7,987
Điểm
560
#2
Em có 1 bảng dữ liệu khai báo nội dung quy chuyển đổi với điều kiện
+ Nếu Đơn vị tính Khai báo nội dung trùng với cột đơn vị tính Khai báo thông tin chuyển bên sheet KhaiBao thì
Mã vật tư và quy cách bên sheet KhaiBao khớp với cột I và J bên sheet data thì Cột số lượng (L) được nhân theo tỉ lệ % ( định dạng theo %) đã khai báo bên sheet KhaiBao( cột G). Còn cột số tiền mua được chia theo số lượng mã được khai báo ví dụ mã HB0001 được chuyển thành 2 mã HH0001 và HH0002 thì giá mua sẽ được chia 2. Còn nếu chia làm 4 mã thì sẽ chia 4.
+ Nếu Đơn vị tính Khai báo nội dung không trùng với cột đơn vị tính Khai báo thông tin chuyển bên sheet KhaiBao thì
Mã vật tư và quy cách bên sheet KhaiBao khớp với cột I và J bên sheet data thì Cột số lượng (L) được nhân theo tỉ lệ (định là là number) đã khai báo bên sheet KhaiBao( cột G). Còn cột số tiền mua được chia theo tỷ lệ ( định dạng là number bên sheet khaibao).
Anh ( Chị ) giúp em đoạn Sub với ạ !. Em cảm ơn Anh (chị ) ạ
Chạy code, kết quả ở sheet data2
Mã:
Sub GPE()
  Dim sArr(), dArr(), tArr(), Res(), S
  Dim i As Long, k As Long, n As Long, j As Long
  Dim iKey As String
 
  With Sheets("KhaiBao")
    dArr = .Range("B3", .Range("G65000").End(xlUp)).Value
  End With
  With Sheets("Data")
    sArr = .Range("A2", .Range("Q65000").End(xlUp)).Value
  End With
  ReDim tArr(1 To UBound(sArr))
  With CreateObject("scripting.dictionary")
    For i = 1 To UBound(dArr)
      .Item(dArr(i, 1)) = .Item(dArr(i, 1)) & "," & i
    Next i
    For i = 1 To UBound(sArr)
      iKey = sArr(i, 9)
      If .exists(iKey) Then
        tArr(i) = Split(.Item(iKey), ",")
        k = k + UBound(tArr(i))
      Else
        tArr(i) = 1
        k = k + 1
      End If
    Next i
  End With
  ReDim Res(1 To k, 1 To UBound(sArr, 2))
  k = 0
  For i = 1 To UBound(sArr)
    If IsNumeric(tArr(i)) Then
      k = k + 1
      For j = 1 To UBound(sArr, 2)
        Res(k, j) = sArr(i, j)
      Next j
    Else
      S = tArr(i)
      For n = 1 To UBound(S)
        k = k + 1
        For j = 1 To UBound(sArr, 2)
          If j < 9 Or j > 14 Then Res(k, j) = sArr(i, j)
        Next j
        ik = CLng(S(n))
        Res(k, 9) = dArr(ik, 4)
        Res(k, 11) = dArr(ik, 5)
        Res(k, 12) = sArr(i, 12) * dArr(ik, 6)
        If dArr(ik, 3) = dArr(ik, 5) Then
          Res(k, 13) = sArr(i, 13) / UBound(S)
        Else
          Res(k, 13) = sArr(i, 13) / dArr(ik, 6)
        End If
        Res(k, 14) = Res(k, 12) * Res(k, 13)
      Next n
    End If
  Next i
  Sheets("Data2").Range("A2").Resize(k, 17) = Res
End Sub
 

File đính kèm

vanvan9697

Thành viên chính thức
Tham gia ngày
11 Tháng năm 2012
Bài viết
68
Thích
5
Điểm
370
Tuổi
40
#3
Chạy code, kết quả ở sheet data2
Mã:
Sub GPE()
  Dim sArr(), dArr(), tArr(), Res(), S
  Dim i As Long, k As Long, n As Long, j As Long
  Dim iKey As String

  With Sheets("KhaiBao")
    dArr = .Range("B3", .Range("G65000").End(xlUp)).Value
  End With
  With Sheets("Data")
    sArr = .Range("A2", .Range("Q65000").End(xlUp)).Value
  End With
  ReDim tArr(1 To UBound(sArr))
  With CreateObject("scripting.dictionary")
    For i = 1 To UBound(dArr)
      .Item(dArr(i, 1)) = .Item(dArr(i, 1)) & "," & i
    Next i
    For i = 1 To UBound(sArr)
      iKey = sArr(i, 9)
      If .exists(iKey) Then
        tArr(i) = Split(.Item(iKey), ",")
        k = k + UBound(tArr(i))
      Else
        tArr(i) = 1
        k = k + 1
      End If
    Next i
  End With
  ReDim Res(1 To k, 1 To UBound(sArr, 2))
  k = 0
  For i = 1 To UBound(sArr)
    If IsNumeric(tArr(i)) Then
      k = k + 1
      For j = 1 To UBound(sArr, 2)
        Res(k, j) = sArr(i, j)
      Next j
    Else
      S = tArr(i)
      For n = 1 To UBound(S)
        k = k + 1
        For j = 1 To UBound(sArr, 2)
          If j < 9 Or j > 14 Then Res(k, j) = sArr(i, j)
        Next j
        ik = CLng(S(n))
        Res(k, 9) = dArr(ik, 4)
        Res(k, 11) = dArr(ik, 5)
        Res(k, 12) = sArr(i, 12) * dArr(ik, 6)
        If dArr(ik, 3) = dArr(ik, 5) Then
          Res(k, 13) = sArr(i, 13) / UBound(S)
        Else
          Res(k, 13) = sArr(i, 13) / dArr(ik, 6)
        End If
        Res(k, 14) = Res(k, 12) * Res(k, 13)
      Next n
    End If
  Next i
  Sheets("Data2").Range("A2").Resize(k, 17) = Res
End Sub
Em cảm ơn anh Hiếu CD ạ. Mặc dù Code này em hơi khó hiểu anh Hiếu ạ.
 
Lần chỉnh sửa cuối:

Thong Hoang Tien 250691

Thành viên hoạt động
Tham gia ngày
14 Tháng năm 2017
Bài viết
119
Thích
112
Điểm
180
Tuổi
27
#4
Em có 1 bảng dữ liệu khai báo nội dung quy chuyển đổi với điều kiện
+ Nếu Đơn vị tính Khai báo nội dung trùng với cột đơn vị tính Khai báo thông tin chuyển bên sheet KhaiBao thì
Mã vật tư và quy cách bên sheet KhaiBao khớp với cột I và J bên sheet data thì Cột số lượng (L) được nhân theo tỉ lệ % ( định dạng theo %) đã khai báo bên sheet KhaiBao( cột G). Còn cột số tiền mua được chia theo số lượng mã được khai báo ví dụ mã HB0001 được chuyển thành 2 mã HH0001 và HH0002 thì giá mua sẽ được chia 2. Còn nếu chia làm 4 mã thì sẽ chia 4.
+ Nếu Đơn vị tính Khai báo nội dung không trùng với cột đơn vị tính Khai báo thông tin chuyển bên sheet KhaiBao thì
Mã vật tư và quy cách bên sheet KhaiBao khớp với cột I và J bên sheet data thì Cột số lượng (L) được nhân theo tỉ lệ (định là là number) đã khai báo bên sheet KhaiBao( cột G). Còn cột số tiền mua được chia theo tỷ lệ ( định dạng là number bên sheet khaibao).
Anh ( Chị ) giúp em đoạn Sub với ạ !. Em cảm ơn Anh (chị ) ạ
Đọc gần đứt hơi. bài viết gì mà tiết kiệm từng dấu chấm, phẩy.
 

vanvan9697

Thành viên chính thức
Tham gia ngày
11 Tháng năm 2012
Bài viết
68
Thích
5
Điểm
370
Tuổi
40
#5
Anh @HieuCD Giúp em với ạ. Em Kiểm tra lại kết quả thấy phần kết quả trong phần phân tách đang nhân tỷ lệ %.
+ với cột số lượng thì Đúng nhưng vậy.
+Còn cột số Tiền thì sẽ phải chia cho số lượng mã phân tách ( dù tỷ lệ % cộng vào không bằng 100 %)
Giả sử mã HB00001 được phân làm 2 mã thì số tiền sẽ bằng số tiền / 2 của từng mã
HB0002 được phân làm 4 mã thì số số tiền sẽ bằng số tiền /4. Của từng mã
Em cảm ơn anh @HieuCD ạ !
 

Ba Tê

Cạo Rồi Khỏi Gội
Tham gia ngày
5 Tháng năm 2009
Bài viết
10,461
Thích
14,739
Điểm
1,560
Tuổi
59
#6
Anh @HieuCD Giúp em với ạ. Em Kiểm tra lại kết quả thấy phần kết quả trong phần phân tách đang nhân tỷ lệ %.
+ với cột số lượng thì Đúng nhưng vậy.
+Còn cột số Tiền thì sẽ phải chia cho số lượng mã phân tách ( dù tỷ lệ % cộng vào không bằng 100 %)
Giả sử mã HB00001 được phân làm 2 mã thì số tiền sẽ bằng số tiền / 2 của từng mã
HB0002 được phân làm 4 mã thì số số tiền sẽ bằng số tiền /4. Của từng mã
Em cảm ơn anh @HieuCD ạ !
Bạn giải thích cách tính cho ra kết quả như vùng N11: N14 của bạn xem sao.
 

File đính kèm

vanvan9697

Thành viên chính thức
Tham gia ngày
11 Tháng năm 2012
Bài viết
68
Thích
5
Điểm
370
Tuổi
40
#7
Bạn giải thích cách tính cho ra kết quả như vùng N11: N14 của bạn xem sao.
Phần trình bày két quả mong muốn của em từ Vùng N11: N14 đang là sai bởi tổng nó đang không khớp với số tiền thực tế bỏ ra. Em cảm ơn anh đã sửa giúp em phần này ạ !
 

Ba Tê

Cạo Rồi Khỏi Gội
Tham gia ngày
5 Tháng năm 2009
Bài viết
10,461
Thích
14,739
Điểm
1,560
Tuổi
59
#11

File đính kèm

HieuCD

Thành viên gạo cội
Tham gia ngày
14 Tháng chín 2010
Bài viết
5,040
Thích
7,987
Điểm
560
#12
Anh @HieuCD Giúp em với ạ. Em Kiểm tra lại kết quả thấy phần kết quả trong phần phân tách đang nhân tỷ lệ %.
+ với cột số lượng thì Đúng nhưng vậy.
+Còn cột số Tiền thì sẽ phải chia cho số lượng mã phân tách ( dù tỷ lệ % cộng vào không bằng 100 %)
Giả sử mã HB00001 được phân làm 2 mã thì số tiền sẽ bằng số tiền / 2 của từng mã
HB0002 được phân làm 4 mã thì số số tiền sẽ bằng số tiền /4. Của từng mã
Em cảm ơn anh @HieuCD ạ !
Làm giống như File bạn gởi mờ :)
Chỉnh lại code
Mã:
Sub GPE()
  Dim sArr(), dArr(), tArr(), Res(), S
  Dim i As Long, k As Long, n As Long, j As Long
  Dim iKey As String
 
  With Sheets("KhaiBao")
    dArr = .Range("B3", .Range("G65000").End(xlUp)).Value
  End With
  With Sheets("Data")
    sArr = .Range("A2", .Range("Q65000").End(xlUp)).Value
  End With
  ReDim tArr(1 To UBound(sArr))
  With CreateObject("scripting.dictionary")
    For i = 1 To UBound(dArr)
      .Item(dArr(i, 1)) = .Item(dArr(i, 1)) & "," & i
    Next i
    For i = 1 To UBound(sArr)
      iKey = sArr(i, 9)
      If .exists(iKey) Then
        tArr(i) = Split(.Item(iKey), ",")
        k = k + UBound(tArr(i))
      Else
        tArr(i) = 1
        k = k + 1
      End If
    Next i
  End With
  ReDim Res(1 To k, 1 To UBound(sArr, 2))
  k = 0
  For i = 1 To UBound(sArr)
    If IsNumeric(tArr(i)) Then
      k = k + 1
      For j = 1 To UBound(sArr, 2)
        Res(k, j) = sArr(i, j)
      Next j
    Else
      S = tArr(i)
      For n = 1 To UBound(S)
        k = k + 1
        For j = 1 To UBound(sArr, 2)
          If j < 9 Or j > 14 Then Res(k, j) = sArr(i, j)
        Next j
        ik = CLng(S(n))
        Res(k, 9) = dArr(ik, 4)
        Res(k, 11) = dArr(ik, 5)
        Res(k, 12) = sArr(i, 12) * dArr(ik, 6)
        Res(k, 14) = sArr(i, 14) / UBound(S)
        If dArr(ik, 3) = dArr(ik, 5) Then
          Res(k, 13) = sArr(i, 13) / UBound(S)
        Else
          Res(k, 13) = sArr(i, 13) / dArr(ik, 6)
        End If
      Next n
    End If
  Next i
  Sheets("Data2").Range("A2").Resize(k, 17) = Res
End Sub
 
Top