chuyển vùng thành 1cột (1 người xem)

[nhtien23]

Chào các anh chị, em là Tiến. Cũng là dân mới trong lập trình Excel.Em nhớ anh chị hỗ trợ cho em một đoạn code để coppy một vùng dữ liệu bất kỳ thành một cột.Em cũng có đính kèm file, mong anh chị giúp dùm.

 

[nghiaphuc]

Chào các anh chị, em là Tiến. Cũng là dân mới trong lập trình Excel.Em nhớ anh chị hỗ trợ cho em một đoạn code để coppy một vùng dữ liệu bất kỳ thành một cột.Em cũng có đính kèm file, mong anh chị giúp dùm.

Bạn dùng file đính kèm dưới đây nhé.

 

[SA_DQ]

Bạn xem thêm trong file kèm theo

Option Explicit
Private Sub Chuyen12ThangThanh1Cot()
 Dim Rng As Range, cRng As Range, Clls As Range
 Dim eRw As Long, jJ As Byte
 
 Set Rng = [b4].CurrentRegion.Offset(3)
 eRw = Rng.Rows.Count:                 Application.ScreenUpdating = False
 Cells(eRw + 5, "B").CurrentRegion.Clear
 
 Cells(eRw + 4, 1).Value = [A2].Value
 Cells(eRw + 4, 2).Value = Left([D1].Value, 8)
 
 For jJ = 2 To Rng.Columns.Count
   Set cRng = Rng.Cells(1, jJ).Resize(eRw)
      With [B65500].End(xlUp).Offset(1, -1)
         .Value = Range("Thang").Cells(1, jJ - 1).Value
         .Interior.ColorIndex = 34 + jJ Mod 6
      End With
      For Each Clls In cRng
         With [B65500].End(xlUp).Offset(1)
            .Value = Cells(Clls.Row, jJ).Value
         End With
      Next Clls
 Next jJ
End Sub

 

[sealand]

Bạn thử đoạn code ngắn của mình xem sao (Mình thấy nó chuẩn hơn cả bạn chép tay mẫu đấy nhé)

Sub ToColumn()
Dim Rg1, Rg2, rg3 As Range
Set Rg1 = Application.InputBox("Nhap vung chuyen:", Type:=8)
Set Rg2 = Application.InputBox("O dau tien cot ket qua:", Type:=8)
For j = 1 To Rg1.Columns.Count
Set rg3 = Rg1.Columns(j)
For Each cel In rg3.Cells
cel.Copy Rg2
Set Rg2 = Rg2.Offset(1)
Next
Next
End Sub

 

[nhtien23]

Cảm ơn tát cả các anh chị!

Em vừa xem các đoạn code của tất cả các anh chị:Nghia Phuc, Hyen 17, Sealand. Trước hết em xin cảm ơn sự giũp đỡ của tất cả các anh chị. Thật là tuyệt vời chỉ mấy giây là xong tất cả.
Cho em hỏi Sealand một chút, em muốn những số liệu phải liên tục, có nghĩa là không có khoảng trống. Mong Sealand giũp em! Một lần nữa em xin cảm ơn tất cả mọi người.
Em có gửi tập tin đính kèm!

 

[sealand]

Cái chuyện không có ô trống thì đơn giản nhưng đã nhờ thì nên đưa dữ liệu rõ ràng . Đừng cố định, ẩn dòng hay Protect mất công lắm.
Bạn chỉ cần thay đoạn

For Each cel In rg3.Cells
cel.Copy Rg2
Set Rg2 = Rg2.Offset(1)
Next

Thành:

For Each cel In rg3.Cells
If cel.Value <> 0 Then cel.Copy Rg2: Set Rg2 = Rg2.Offset(1)
Next

Lưu ý: Nếu có dữ liệu là năm nào thì sẽ xác định ngày cuối tháng của từng tháng để chép thì mới chuẩn, đề phòng ngày thiếu dữ liệu. Mình tạm căn cứ ngày không có dữ liệu thì bỏ qua

 

[sealand]

Mình sửa Code đẻ chuyển theo ngày trong năm. Dữ liệu của bạn là năm nhuận nhưng nếu bạn khai báo năm không nhuận nó sẽ bỏ đi ngày 29/2. Đồng thời mình thêm cột ngày cho tiện việc đối chiếu

Sub ToColumn()
Dim nam As Integer
Dim ch As String
Dim Rg1, Rg2, rg3 As Range
nam = InputBox("Nhap nam 4 chu so")
Set Rg1 = Application.InputBox("Nhap vung chuyen:", Type:=8)
Set Rg2 = Application.InputBox("O dau tien cot ket qua:", Type:=8)
ch = IIf(nam Mod 4 = 0, "312931303130313130313031", "312831303130313130313031")
For j = 1 To Rg1.Columns.Count
Set rg3 = Rg1.Columns(j)
For i = 1 To Mid(ch, j * 2 - 1, 2)
Rg1.Cells(i, j).Copy Rg2: Rg2.Offset(, 1).Value = DateSerial(nam, j, i): Set Rg2 = Rg2.Offset(1)
Next
Next
End Sub

 

[mokara30]

Cũng với câu hỏi gần giống như trên, nhưng tôi muốn làm cho khoảng 2 sheets trở lên thì sao. Nghĩa là tôi muốn nối cột của sheet thứ 2 sau cột thứ nhất?....

 

[sealand]

Chỉ cần sửa đi chút xíu là được. Vấn đề ở chỗ Set Rg=....

 

[SA_DQ]

cho SPAM 15 fút, khà, khà,. . .

Câu lệnh

ch = IIf(nam Mod 4 = 0, "312931303130313130313031", "312831303130313130313031")

Tại #7 có thể viết gọn lại!

[COLOR=Purple][B]
 Ch ="312" & IIf(Nam Mod 4 =0 , "9","8") & "31303130313130313031" [/B][/COLOR]

 

[mokara30]

Chỉ cần sửa đi chút xíu là được. Vấn đề ở chỗ Set Rg=....

Trước hết chân thành cảm ơn bác Sealand đã quan tâm, nhưng em còn gà lắm, bác có thể bớt chút thời gian chỉ dẫn được hok? Thanks bác. Em có 1 workbook gồm 20 sheets, mỗi sheet chứa dữ liệu của 12 tháng, bây giờ em muốn lọc dữ liệu ra một sheet mới ( xếp theo 1 cột, từ tháng 1 -tháng 12 năm 80, tiếp theo là tháng 1- tháng 12 năm 81 ...)

 

[huuthang_bd]

Trước hết chân thành cảm ơn bác Sealand đã quan tâm, nhưng em còn gà lắm, bác có thể bớt chút thời gian chỉ dẫn được hok? Thanks bác. Em có 1 workbook gồm 20 sheets, mỗi sheet chứa dữ liệu của 12 tháng, bây giờ em muốn lọc dữ liệu ra một sheet mới ( xếp theo 1 cột, từ tháng 1 -tháng 12 năm 80, tiếp theo là tháng 1- tháng 12 năm 81 ...)

Nếu tất cả các sheet của bạn đều có cùng một cấu trúc thì có thể dùng công thức. Bạn xem trong file, tôi giả lập dữ liệu cho 4 năm.

 

[sealand]

cho SPAM 15 fút, khà, khà,. . .

Spam kiểu này mời Bác Spam cả ngày. Cám ơn Bác nhiều.

Trước hết chân thành cảm ơn bác Sealand đã quan tâm, nhưng em còn gà lắm, bác có thể bớt chút thời gian chỉ dẫn được hok? Thanks bác. Em có 1 workbook gồm 20 sheets, mỗi sheet chứa dữ liệu của 12 tháng, bây giờ em muốn lọc dữ liệu ra một sheet mới ( xếp theo 1 cột, từ tháng 1 -tháng 12 năm 80, tiếp theo là tháng 1- tháng 12 năm 81 ...)

Thì bạn cứ đưa file lên đi chứ giờ làm dữ liệu giả định mà lại không đúng ý ban thì mất công lắm.

 

[sealand]

Bạn tham khảo 1 cách tận dụng nhé

 

[mokara30]

thanks bác Sealand nhiều nhé. Chúc một ngày vui vẻ

Chào anh em trong diễn đàn. Hôm nay em lại có thời gian quay lại diễn đàn, với cùng một câu hỏi của chủ đề này nhưng rộng hơn chút xíu, em có gửi file đính kèm, gồm nhiều sheet có cấu trúc giống nhau, và muốn tổng hợp số liệu từ nhiều sheet đó thành một cột (cụ thể thì em đã ghi trong sheet "TH" rùi). Rất mong được các pác chỉ giúp em cái nha.

 

[sealand]

Bạn test thử file xem có đạt không
Có nút thank ở dưới đỡ phải trích dẫn làm câu hỏi gọn gàng hơn.

 

[mokara30]

Cảm ơn pác Sealand nhiều nhé. Dữ liệu cần lọc từ 1980-1999 thì hoàn toàn chính xác, nhưng từ năm 2000 trở đi thì lại sai mất, pác bỏ chút thời gian xem lại giúp em cái nhá. Thanks!

 

[sealand]

Sơ suất 1 chút mình xin cải chính nhé

Bạn phải lưu ý bảng năm 2005 không bình thường nhé. Bạn phải chọn các ô trống như từ 29/2--31/2,31/4....delete thì mới đúng được. Các ô đó không trống đâu nha.

 

[TrungChinhs]

Cảm ơn pác Sealand nhiều nhé. Dữ liệu cần lọc từ 1980-1999 thì hoàn toàn chính xác, nhưng từ năm 2000 trở đi thì lại sai mất, pác bỏ chút thời gian xem lại giúp em cái nhá. Thanks!

Bạn thử code này xem - xóa toàn bộ dữ liệu trong Sheet TongHop và chạy code để kiểm tra.

Sub TongHop()
Application.ScreenUpdating = False
    Sheets("TongHop").[b2:c65536].ClearContents
    For Each sh In Worksheets
        If sh.Name <> Sheets("TongHop").Name Then
            For i = 1 To 12
                For Each cls In sh.Cells(7, i + 2).Resize(31) '.SpecialCells(2)
                    cls.Offset(, -i - 1).ClearContents
                    If cls > 0 Then cls.Offset(, -i - 1).Value = cls.Offset(, -i) & "/" & i & "/" & sh.Name
                    cls.Offset(, -i - 1).NumberFormat = "mm/d/yy"
                Next
                sh.Cells(7, i + 2).Resize(31).Copy Sheets("TongHop").[b65536].End(3)(2)
                sh.[a7].Resize(31).Copy Sheets("TongHop").[c65536].End(3)(2)
            Next
            sh.[a7].Resize(31).ClearContents
        End If
    Next
End Sub

 

[mokara30]

pác sealand kiểm tra lại giúp em là tại sao lại xuất hiện dữ liệu của năm 2009, trong khi không có data