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

Liên hệ QC

vanvan9697

Thành viên chính thức
Tham gia
11/5/12
Bài viết
94
Được thích
5
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

  • Khai bao noi dung.xlsx
    12.8 KB · Đọc: 12
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

  • Khai bao noi dung.xlsm
    23.7 KB · Đọc: 13
Upvote 0
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:
Upvote 0
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.
 
Upvote 0
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 ạ !
 
Upvote 0
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

  • Khai bao noi dung.rar
    23.9 KB · Đọc: 5
Upvote 0
Anh @Ba Tê ơi anh có thể giúp em hiện hết các kết quả dù không khai báo từ sheet khai báo sang không anh ?
 
Upvote 0
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
 
Upvote 0
Web KT
Back
Top Bottom