BlogGang.com : : คนควน : การจัดเรียงข้อมูลที่กระจัดกระจายไว้ในคอลัมน์เดียว

การจัดเรียงข้อมูลที่กระจัดกระจายไว้ในคอลัมน์เดียว

         การจัดเรียงข้อมูลที่กระจัดกระจายอยู่หลายคอลัมน์ให้มาเรียงในคอลัมน์เดียว นั้น ดูเหมือนว่าหากใช้ VBA ค่อนข้างจะสะดวกกว่าการใช้สูตรครับ

        ตัวอย่างตามด้านล่างจะเป็นการจัดเรียงข้อมูลที่อยู่ตั้่งแต่คอลัมน์ B เป็นต้นไปมาเรียงใหม่ในคอลัมน์ A โดยเรียงเป็นชุดข้อมูลตามลำดับคอลัมน์ หลักการที่จะทำให้คำนวณได้รวดเร็วนั้นจะต้องนำค่าที่ได้ไปใส่ใน Array จากนั้นค่อยนำค่าจาก Array มาจัดเีรียงใหม่

        อีกประการหนึ่งที่สำคัญคือจะต้องหาว่าพื้นที่ใช้งานนั้นมีกี่บรรทัดและมีกี่แถวเพื่อใช้กำหนดขอบเขตในการ Loop ซึ่งจะช่วยเพิ่มความยืดหยุ่นทั้่งให้คำนวณรวดเร็วขึ้นกว่าการกำหนดขอบเขตเผื่อเอาไว้ครับ

---------------------------------------------
Public Sub ListData()
Dim iTotalRow As Integer
Dim iTotalCol As Integer
Dim i As Integer, j As Integer
Dim iCount As Integer, k As Integer
Dim rRange As Range
Dim wsh As Worksheet
Dim AllData() As String
Set wsh = ActiveSheet
wsh.Range("A:A").ClearContents
Set rRange = wsh.UsedRange
iTotalRow = rRange.Rows.Count
iTotalCol = rRange.Columns.Count
k = Application.CountA(rRange)
ReDim AllData(1 To k)
For j = 2 To iTotalCol + 1
   For i = 1 To iTotalRow
        If Cells(i, j) <> "" Then
            iCount = iCount + 1
            AllData(iCount) = Cells(i, j)
        End If
    Next i
Next j
For i = 1 To UBound(AllData)
    Cells(i, 1) = AllData(i)
Next i
End Sub

---------------------------------------------

         แต่หากต้องการให้เรียงตามลำดับแถว Code จะสั้นลงเนื่องจากสามารถใช้ For Each...Next มาเรียงลำดับได้ ตามตัวอย่างด้านล่างครับ

---------------------------------------------

Sub NewArrange()
Dim r As Range, c As Range
Dim iCount As Integer
Dim wsh As Worksheet
Set wsh = ActiveSheet
wsh.Range("A:A").ClearContents
Set r = ActiveSheet.UsedRange
For Each c In r
    If c <> "" Then
        iCount = iCount + 1
        Cells(iCount, 1) = c
    End If
Next c
End Sub

---------------------------------------------

        และหากว่าต้องการให้ข้อมูลที่นำมาเรียงใหม่นั้นถูกจัดเรียงจากน้อย ไปหามาก สามารถเพิ่ม Code สำหรับจัดเรียงไว้ข้างท้ายได้ตามตัวอย่างด้านล่างครับ

---------------------------------------------

Sub NewArrange()
Dim r As Range, c As Range
Dim iCount As Integer
Dim wsh As Worksheet
Set wsh = ActiveSheet
wsh.Range("A:A").ClearContents
Set r = ActiveSheet.UsedRange
For Each c In r
    If c <> "" Then
        iCount = iCount + 1
        Cells(iCount, 1) = c
    End If
Next c
wsh.Range("A:A").Sort Key1:=Range("A1"), _
    Order1:=xlAscending, Orientation:=xlTopToBottom
End Sub

---------------------------------------------

กรณีมีปัญหา Excel สามารถสอบถามได้ที่ //www.snasui.com ครับ

Create Date : 26 มีนาคม 2552

Last Update : 10 กุมภาพันธ์ 2556 19:52:07 น.

0 comments

Counter : 1003 Pageviews.