Xuất dữ liệu từ sheet này qua sheet khác và sắp xếp lại cột theo điều kiện

[tainguyen0806]

Chào các anh/chị.

Em đang làm kiểm tra giá cho sản phẩm của công ty. Mong mọi người giúp đỡ cho e.

Ở sheet1, sẽ gồm các cột Địa Phương, Mã SP (1,2,3) và Giá SP (1,2,3)
Em muốn xuất dữ liệu sang sheet2, nhưng lúc nãy các mã SP sẽ gom về 1 cột và không tách ra nửa.
Ứng với mỗi mã sản phẫm đó thì sẽ là địa phương và giá giống sheet1.

Vì file này ví dụ nên em chỉ copy 1 phần nhỏ ra. File chính thật sự rất nhiều nên em ko làm thủ công được.
Mong mọi người chỉ em 1 cách nào đó nhanh hơn đc ko ạh

 

[Ba Tê]

Chào các anh/chị.

Em đang làm kiểm tra giá cho sản phẩm của công ty. Mong mọi người giúp đỡ cho e.

Ở sheet1, sẽ gồm các cột Địa Phương, Mã SP (1,2,3) và Giá SP (1,2,3)
Em muốn xuất dữ liệu sang sheet2, nhưng lúc nãy các mã SP sẽ gom về 1 cột và không tách ra nửa.
Ứng với mỗi mã sản phẫm đó thì sẽ là địa phương và giá giống sheet1.

Vì file này ví dụ nên em chỉ copy 1 phần nhỏ ra. File chính thật sự rất nhiều nên em ko làm thủ công được.
Mong mọi người chỉ em 1 cách nào đó nhanh hơn đc ko ạh

Nếu biết sử dụng VBA thì tặng bạn Sub này.
Enable Macros khi mở file rồi bấm nút là xong
[GPECODE=vb]Public Sub GPE()
Dim sArr(), dArr(), I As Long, J As Long, K As Long
With Sheet1
sArr = .Range(.[A2], .[A65536].End(xlUp)).Resize(, 7).Value
End With
ReDim dArr(1 To UBound(sArr, 1) * 3, 1 To 3)
For I = 1 To UBound(sArr, 1)
For J = 2 To 4
If sArr(I, J) <> Empty Then
K = K + 1
dArr(K, 1) = sArr(I, 1)
dArr(K, 2) = sArr(I, J)
dArr(K, 3) = sArr(I, J + 3)
End If
Next J
Next I
With Sheet2
.[A2:C50000].ClearContents
If K Then
.[A2].Resize(K, 3) = dArr
.[A2].Resize(K, 3).Sort Key1:=.[A2], Key2:=.[B2]
End If
End With
End Sub[/GPECODE]

 

[Quang_Hải]

Chào các anh/chị.

Em đang làm kiểm tra giá cho sản phẩm của công ty. Mong mọi người giúp đỡ cho e.

Ở sheet1, sẽ gồm các cột Địa Phương, Mã SP (1,2,3) và Giá SP (1,2,3)
Em muốn xuất dữ liệu sang sheet2, nhưng lúc nãy các mã SP sẽ gom về 1 cột và không tách ra nửa.
Ứng với mỗi mã sản phẫm đó thì sẽ là địa phương và giá giống sheet1.

Vì file này ví dụ nên em chỉ copy 1 phần nhỏ ra. File chính thật sự rất nhiều nên em ko làm thủ công được.
Mong mọi người chỉ em 1 cách nào đó nhanh hơn đc ko ạh

Nếu không chịu kết quả như bài số 2 thì xài code này sẽ ra đúng như kết quả tạm của bạn

Sub tachtach()
Dim data(), Res(1 To 65536, 1 To 3), I, K, X
With Sheet1
   data = .Range(.[A2], .[A65536].End(3)).Resize(, 7).Value
End With
For X = 2 To 4
   For I = 1 To UBound(data)
      If data(I, X) <> "" Then
         K = K + 1
         Res(K, 1) = data(I, 1)
         Res(K, 2) = data(I, X)
         Res(K, 3) = data(I, X + 3)
      End If
   Next
Next
Sheet2.[A2].Resize(K, 3) = Res
End Sub

 

[tainguyen0806]

vậy các anh có thể chỉ em giúp là nếu mình có 5 cột mã sp và 5 cột giá thì trong đoạn code em cần đổi chỗ nào ko ạh.

 

[Ba Tê]

vậy các anh có thể chỉ em giúp là nếu mình có 5 cột mã sp và 5 cột giá thì trong đoạn code em cần đổi chỗ nào ko ạh.

Bạn xem trong code của quanghai1969:
data = .Range(.[A2], .[A65536].End(3)).Resize(, 7).Value
Bảng dữ liệu của bạn có 7 cột (1 địa phương + 3 Mã + 3 giá)
Nếu có 3 cột Mã thì:
For X = 2 To 4
X chạy từ cột 2 đến cột 4 (3 cột)
Res(K, 3) = data(I, X + 3)
Sổ 3 cuối cùng là số lượng cột mã ( 3 cột)
Bạn tuỳ chỉnh đi.

 

[Quang_Hải]

vậy các anh có thể chỉ em giúp là nếu mình có 5 cột mã sp và 5 cột giá thì trong đoạn code em cần đổi chỗ nào ko ạh.

Tìm chỗ nào là 2 to 4 sửa lại thành 2 to 5 hay 6... thử xem

*************
Hic, nhìn không thấy ai mới trả lời. Trả lời xong thì nằm sau nài anh Ba. Hức hức

 

[Ba Tê]

Tìm chỗ nào là 2 to 4 sửa lại thành 2 to 5 hay 6... thử xem

*************
Hic, nhìn không thấy ai mới trả lời. Trả lời xong thì nằm sau nài anh Ba. Hức hức

Nhờ nằm sau mà tác giả khỏi "chết". hihihi

 

[Quang_Hải]

Nhờ nằm sau mà tác giả khỏi "chết". hihihi

Anh làm em xấu hổ quá.
Lỡ rồi làm cho tác giả code này luôn, khỏi thêm bớt gì cả. Cứ bấm là chạy. Mấy cột cũng xơi hết.

Sub tachtach()
Dim data(), Res(1 To 65536, 1 To 3), I, K, X, N
data = Sheet1.[A1].CurrentRegion.Offset(1).Value
N = ((UBound(data) - 1) / 2) - 1
For X = 2 To N
   For I = 1 To UBound(data)
      If data(I, X) <> "" Then
         K = K + 1
         Res(K, 1) = data(I, 1)
         Res(K, 2) = data(I, X)
         Res(K, 3) = data(I, X + N - 1)
      End If
   Next
Next
Sheet2.[A2].Resize(K, 3) = Res
End Sub

 

[tainguyen0806]

Thanks 2 bác nhiệt tình wá .

em bỏ code bác quanghai1969

Sub tachtach()
Dim data(), Res(1 To 65536, 1 To 3), I, K, X
With Sheet1
data = .Range(.[A2], .[A65536].End(3)).Resize(, 7).Value
End With
For X = 2 To 4
For I = 1 To UBound(data)
If data(I, X) <> "" Then
K = K + 1
Res(K, 1) = data(I, 1)
Res(K, 2) = data(I, X)
Res(K, 3) = data(I, X + 3)
End If
Next
Next
Sheet2.[A2].Resize(K, 3) = Res
End Sub

Thì chạy kết quả chỉ ra HCM ... ko ra mấy cái khác ... Hok biết mình có copy bỏ vào sai gì ko.

Code thứ 2 a đưa em chạy thì nó kêu debug end ... ko phãi dân code nên hok biết nó bị gì luôn.

Nhưng mà theo các anh giải thích thì em hiểu như vầy, ko biết đúng sai... có gì góp ý giúp em nha

Public Sub GPE()
Dim sArr(), dArr(), I As Long, J As Long, K As Long
With Sheet1
sArr = .Range(.[A2], .[A65536].End(xlUp)).Resize(, 7).Value
End With
ReDim dArr(1 To UBound(sArr, 1) * 3, 1 To 3)
For I = 1 To UBound(sArr, 1)
For J = 2 To 4
If sArr(I, J) <> Empty Then
K = K + 1
dArr(K, 1) = sArr(I, 1)
dArr(K, 2) = sArr(I, J)
dArr(K, 3) = sArr(I, J + 3)
End If
Next J
Next I
With Sheet2
.[A2:C50000].ClearContents
If K Then
.[A2].Resize(K, 3) = dArr
.[A2].Resize(K, 3).Sort Key1:=.[A2], Key2:=.[B2]
End If
End With
End Sub

-------------------------
Ở code này,

sArr = .Range(.[A2], .[A65536].End(xlUp)).Resize(, 7).Value
7 là số lượng cột

ReDim dArr(1 To UBound(sArr, 1) * 3, 1 To 3)
3 này là do mình có 3 cột sản phẩm và 3 cột mã

For J = 2 To 4
thì cái này là thứ tự cột mã sp là từ B --> D ( 2 tới 4 ko)

vậy nên từ code trên nếu đổi sang sp có 5 mã và 5 giá thì code thành như vầy

Public Sub GPE()
Dim sArr(), dArr(), I As Long, J As Long, K As Long
With Sheet1
sArr = .Range(.[A2], .[A65536].End(xlUp)).Resize(, 11).Value
End With
ReDim dArr(1 To UBound(sArr, 1) * 5, 1 To 5)
For I = 1 To UBound(sArr, 1)
For J = 2 To 6
If sArr(I, J) <> Empty Then
K = K + 1
dArr(K, 1) = sArr(I, 1)
dArr(K, 2) = sArr(I, J)
dArr(K, 3) = sArr(I, J + 3)
End If
Next J
Next I
With Sheet2
.[A2:C50000].ClearContents
If K Then
.[A2].Resize(K, 3) = dArr
.[A2].Resize(K, 3).Sort Key1:=.[A2], Key2:=.[B2]
End If
End With
End Sub

 

[tainguyen0806]

àh xin lỗi bác Quanghai, code 1 chạy đc.... do sheet1 mình lỡ để filter HCM .
Có code 2 hok đc... bác check giúp với

 

[Quang_Hải]

àh xin lỗi bác Quanghai, code 1 chạy đc.... do sheet1 mình lỡ để filter HCM .
Có code 2 hok đc... bác check giúp với

Code bài 8 nếu không chạy được là do cấu trúc của bạn không giống như file đã gởi lên lúc đầu. >>> Chán.

 

[Zerothink]

Code bài 8 nếu không chạy được là do cấu trúc của bạn không giống như file đã gởi lên lúc đầu. >>> Chán.

Lập trình VBA excel cứ phụ thuộc cấu trúc dữ liệu, mệt nhỉ, dễ chán nản khi thành viên post bài thay đổi yêu cầu liên tục, chút nữa chắc lại khác