ขอความรู้ ภาษา VBA หน่อยครับ ต้องการจะนำค่าทีไม่ซ้ำใน array

[angleblack]

arrhd = Split(Cells(I, 2).Value, "@")
Resultname = arrhd(0)

ตอนนี้คือว่า ใน array() arrhdมี a,b,c,a,c

ผมต้องการจะให้มันเอา ค่าทีซ้ำกันใน arrhd มาshowใน Resultname

[logic]

คงไม่มีคนกล้าช่วย เพราะผิดกฎข้อ 1 ครับ

ช่วยอ่านกฎทุกข้อก่อนครับ

[angleblack]

arrhd = Split(Cells(I, 2).Value, "@")
Resultname = arrhd(0)

ใน array() arrhdมีค่า a,b,c,a,c

ผมต้องการจะให้นำเอาค่าทีซ้ำกันใน arrhd มาshowใน Resultname

[snasui]

ช่วยอ่านกฎการใช้บอร์ดด้านบนอีกครั้ง ในฟอรัมถามตอบห้ามใช้ภาษาแชทครับ ถ้าเขียนคำว่า ครับ เป็น คับ มาอีกรอบโดยเจตนาจะโดนแบนครับ

[snasui]

arrhd = Split(Cells(I, 2).Value, "@")
Resultname = arrhd(0)

ใน array() arrhdมีค่า a,b,c,a,c

ผมต้องการจะให้นำเอาค่าทีซ้ำกันใน arrhd มาshowใน Resultname

จากคำถามด้านบน คำตอบของ Resultname คือค่าใดครับ

ควรแนบไฟล์พร้อม Code มาด้วย เพื่อนสมาชิกจะได้ช่วยทดสอบได้ครับ

[angleblack]

Function GetResultName(ByVal Resultbook As Workbook) As Variant

Dim Item As Variant
Dim Count, NumUnique, CountResult, CountDup As Integer
Dim Resultname As String


Dim Element() As Variant
Dim FoundMatch As Boolean
'''Dim Returnindex As Integer: Returnindex = 0 '' index of _error, _Result

Count = 0
NumUnique = 0
CountResult = 0
On Error GoTo ResultNotFound

Resultbook.Sheets("Result (2)").Select
With ActiveSheet


last_row = Range("B" & Rows.Count).End(xlUp).Row
'last_row = 7
start_row = 2

For I = start_row To last_row
arrhd = Split(Cells(I, 2).Value, "@")
Resultname = arrhd(0)



If Resultname = "" Then
GoTo ResultNotFound
Else
ReDim Preserve Element(0 To Count)
Element(Count) = Resultname
Count = Count + 1
End If
Next


'''/// fine Unique name of Format '''
If Count > 0 Then
For Each Item In Element
FoundMatch = False
If NumUnique = 0 Then
FoundMatch = False
GoTo AddItem '(Exit For-Next loop)
End If
'Has item been added yet?
For I = 0 To NumUnique - 1
If Item = CountResultByLocation(I).Resultname Then
FoundMatch = True
CountDup = CountResultByLocation(I).ResultNumber + 1
CountResultByLocation(I).ResultNumber = CountDup
End If
Next I

AddItem:
' If not in list, add the item to unique list
If Not FoundMatch Then
CountResult = 1
ReDim Preserve CountResultByLocation(NumUnique)
CountResultByLocation(NumUnique).ResultNumber = CountResult
CountResultByLocation(NumUnique).Resultname = Item
NumUnique = NumUnique + 1
End If

Next Item

GetResultName = True

Exit Function
Else
GoTo ResultNotFound
End If



End With


ResultNotFound:

GetResultName = False
End Function


arrhd เก็บค่าเป็น array ผมต้องการทีจะ ให้ แสดงข้อมูลทีเก็บใน arrhd ออกโดยเอาค่าืทีไม่ได้ ซ้ำกัน ออกมา โชว์ใน Resultname ตอนนี้ผมสามารถทำให้ Resultname แสดงค่า แรกของ array ออกมาได้ แต่ว่า ผมคิดไม่ออกว่าจะทำยังไงให้ แสดงค่า ทีไม่ซ้ำกันใน array ออกมานะครับ เลยมาขอคำแนะนำ ขอโทษด้วยครับที แนบ ไฟล์มาไม่ได้เพราะว่า มันต้องมีดึง ข้อมูลจาก ไฟล์ excel มาเก็บค่าแล้วก็นำมาหาค่าอ่ะครับ

[snasui]

สามารถใช้ Collection เข้ามาช่วยได้ ลองดูตัวอย่างที่นี่ครับ http://www.mrexcel.com/forum/excel-ques ... ost1501481

สำหรับการ Post Code ให้เป็น Code ดูที่นี่ครับ http://www.snasui.com/viewtopic.php?f=2&t=1187

[angleblack]

ผมลองใช้ละครับ

Code: Select all

 arrhd = Split(Cells(I, 2).Value, "@")
            'aa.Add arrhd()
            Resultame = arrhd(0)
            ' If Not (arrhd()) Then
            ' Resultname = aa.Add arrhd()
            ' End If
               ' arrhd = Split(Cells(I, 2).Value, "@")
               '     Resultname = arrhd(0)

ก็ยังไม่ไม่ได้ครับ ลองใช้ Collection ดึงมาหมดทุกคำ แล้วลองใช้ If Not แบบ vb ก็ไม่ผ่าน แต่เดียวลองหาวิธีอื่นก่อนครับ

[snasui]

Code ที่ Post มาไม่เห็นว่ามีการใช้ Collection เข้ามาช่วย ลอง Post Code ดังกล่าวมาด้วยครับ

หลักการคือ นำ Array ต้นแหล่งไป Loop เพื่อ Add เข้า Collection ซึ่งจะ Add เข้าไปได้เฉพาะค่าที่ไม่ซ้ำ

จากนั้นนำ Collection กลับมาใส่ Array ซึ่งจะได้ Array ของค่าที่ไม่ซ้ำ

[angleblack]

ผมตั้ง

Dim aa As New Collection


ครับ

[snasui]

ตัวอย่าง Code ครับ

Code: Select all

Sub testUniqueValInArray()
    Dim arrhd As Variant, aa As New Collection
    Dim b() As Variant, k As Variant
    Dim j As Integer, i As Integer
    i = 1
    arrhd = Split(Cells(i, 2).Value, "@")
    On Error Resume Next
    For Each k In arrhd
        aa.Add k, k
    Next k
    On Error GoTo 0
    ReDim b(0 To aa.Count - 1)
    For j = 0 To aa.Count - 1
        b(j) = aa(j + 1)
    Next j
    Resultame = b(0)
End Sub

[angleblack]

ผมได้ทำการลองเล่น มาทั้งคืน ครับ
Resultame ไม่ยอมรับค่า string จาก b(0) ผมก็ได้ตั้ง ให้ Resultame เป็น string แล้วนะครับ

[snasui]

เครื่องผมทำงานได้เป็นปกติครับ ไม่ว่าจะเท่ากับ b(0) หรือ b(n)

Note: n คือ ตำแหน่งใด ๆ ใน Array b

[angleblack]

ครับ ผมแค่แปลกใจว่าทำไหม Resultame ถึงไม่ยอมเก็บค่า string ของ b(0)

[snasui]

ลองตรวจสอบว่ามีการกำหนดเป็น Option Base 1 เพื่อให้ Array เริ่มขอบเขตล่างที่ 1 แทนที่จะเป็น 0 ไว้หรือไม่ครับ

[angleblack]

ลองละครับ

[angleblack]

พอมีวิธีช่วยผมหน่อยได้รึป่าวครับ งง มากเลย ครับ

Code: Select all

last_row = Range("B" & Rows.Count).End(xlUp).Row
            start_row = 2
            
            For i = start_row To last_row
                arrhd = Split(Cells(i, 2).Value, "@")
Resultname = arrhd(0)
Resultname1 = arrhd(1)
Resultname2 = arrhd(2)

ผมใช้ Code ชุดนี้ สามารถ Get ค่า string ลง Resultname ได้อ่ะครับ

แต่พอใช้Code

Code: Select all

  For i = start_row To last_row
                Dim aa As New Collection
                Dim b() As Variant
                Dim k As Variant
                Dim j As Integer
                Dim z As Integer
                z = 1
                arrhd = Split(Cells(i, 2).Value, "@")
                On Error Resume Next
                For Each k In arrhd
                    aa.Add k, k
                Next k
                On Error GoTo 0
                ReDim b(0 To aa.Count - 1)
                For j = 0 To aa.Count - 1
                    b(j) = aa(j + 1)
                Next j
                Resultame = b(0)
                Resultame1 = b(1)
                Resultame2 = b(2)

แต่Getค่า ลงResultame ไม่ได้ มันผิดปกติตรงไหนหรอครับช่วยบอกหน่อย

[snasui]

คำว่า ป่าว ควรเป็น เปล่า หรือคำว่า หรือไม่ แทน ส่วนคำว่า อ่ะ ไม่จำเป็นต้องใช้ครับ

ช่วยทำไฟล์ตัวอย่างที่บอกว่าไม่ได้แนบมาด้วย จะได้ช่วยทดสอบได้ Code นั้นผมแจ้งไปแล้วว่าเครื่องผมทำงานได้เป็นปกติครับ

[angleblack]

ขอบคุณมากครับ ทีให้คำแนะนำ