Các câu hỏi về mảng trong VBA (Array)

viehoai · 24/3/11

Xin các anh chị giúp đỡ Code Gán các giá trị của một Range là các phần tử của Mãng
Ví dụ: Tôi có các giá trị của Range("A1:A10"). Tôi muốn viết code để gán giá trị của các cells từ A1:A10 là các phần tử của Mãng Arr chẳn hạn.
Xin cảm ơn các anh chị

Ba Tê · 13/11/13

cartoon18 đã viết:
lấy dư lệu từng sheet thì em làm được rồi cách làm thế này, cũng đoạn code trên em lấy dữ liệu sheet2 cột tháng 1 xong đưa sang sheet4, sau đó sang sheet1 lấy dữ liệu và đưa sang sheet 4, em muốn là lấy dữ liệu sheet1, sheet 2 xong mói đưa dữ liệu sang sheet4 một lúc cơ

Thì cứ dùng mảng Arr() đó, gán sheet1 vào rồi, gán tiếp sheet2 vào với k=k+1 tiếp tục, xong rồi hãy gán vào sheet4 1 lần.

thnghiachau · 16/11/13

Chào các Thầy trên GPE,

Mình có chút vấn đền nhỏ không biết như thế nào... làm mãi vẫn không đúng.
Vui lòng xem file đính kèm.
[GPECODE=VB]
Sub ShowResult_OR()
Dim rngCellData1, rngCellData2, rngList1, rngList2 As Range
Dim wksTemp As Worksheet
Dim iLastRow1, iLastRow2, iLastRowResult, i As Long
Dim Dic, arrResult_OR
Set wksTemp = Worksheets("Temp")
iLastRow1 = LastRow(wksTemp, 3)
iLastRow2 = LastRow(wksTemp, 5)
iLastRowResult = LastRow(wksTemp, 7)
wksTemp.Range("G4:G" & iLastRowResult).Select
Selection.Clear
wksTemp.Range("G4").Select
Set rngList1 = wksTemp.Range("C4:C" & iLastRow1)
Set rngList2 = wksTemp.Range("E4:E" & iLastRow2)
On Error Resume Next
Set Dic = CreateObject("Scripting.Dictionary")
For Each rngCellData1 In rngList1
If Not IsEmpty(rngCellData1) Then Dic.Add rngCellData1.Value, ""
Next rngCellData1
For Each rngCellData2 In rngList2
If Not IsEmpty(rngCellData2) Then Dic.Add rngCellData2.Value, ""
Next rngCellData2

arrResult_OR = Dic.Keys

wksTemp.Range("G4").Resize(UBound(arrResult_OR, 1) + 1, 1) = arrResult_OR

'For i = 0 To UBound(arrResult_OR, 1)
'wksTemp.Range("G" & i + 4) = arrResult_OR(i)
'Next i

Set Dic = Nothing
'Sort
wksTemp.Sort.SortFields.Clear
wksTemp.Sort.SortFields.Add Key:=Range("G4:G3" & UBound(arrResult_OR, 1) + 4), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With wksTemp.Sort
.SetRange Range("G3:G3" & UBound(arrResult_OR, 1) + 4)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
TotalFile 7, "G3"

End Sub
[/GPECODE]

nếu chạy đoạn code tô màu đỏ thì ra kết quả sai!!!
wksTemp.Range("G4").Resize(UBound(arrResult_OR, 1) + 1, 1) = arrResult_OR --> kết quả sai

nếu chạy lại bẳng cách thay đoạn code màu đỏ bằng màu xanh thì ra kết quả đúng!!!!

For i = 0 To UBound(arrResult_OR, 1)
wksTemp.Range("G" & i + 4) = arrResult_OR(i)
Next i

[GPECODE=VB]

Sub ShowResult_OR()
Dim rngCellData1, rngCellData2, rngList1, rngList2 As Range
Dim wksTemp As Worksheet
Dim iLastRow1, iLastRow2, iLastRowResult, i As Long
Dim Dic, arrResult_OR
Set wksTemp = Worksheets("Temp")
iLastRow1 = LastRow(wksTemp, 3)
iLastRow2 = LastRow(wksTemp, 5)
iLastRowResult = LastRow(wksTemp, 7)
wksTemp.Range("G4:G" & iLastRowResult).Select
Selection.Clear
wksTemp.Range("G4").Select
Set rngList1 = wksTemp.Range("C4:C" & iLastRow1)
Set rngList2 = wksTemp.Range("E4:E" & iLastRow2)
On Error Resume Next
Set Dic = CreateObject("Scripting.Dictionary")
For Each rngCellData1 In rngList1
If Not IsEmpty(rngCellData1) Then Dic.Add rngCellData1.Value, ""
Next rngCellData1
For Each rngCellData2 In rngList2
If Not IsEmpty(rngCellData2) Then Dic.Add rngCellData2.Value, ""
Next rngCellData2

arrResult_OR = Dic.Keys

'wksTemp.Range("G4").Resize(UBound(arrResult_OR, 1) + 1, 1) = arrResult_OR

For i = 0 To UBound(arrResult_OR, 1)
wksTemp.Range("G" & i + 4) = arrResult_OR(i)
Next i

Set Dic = Nothing
'Sort
wksTemp.Sort.SortFields.Clear
wksTemp.Sort.SortFields.Add Key:=Range("G4:G3" & UBound(arrResult_OR, 1) + 4), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With wksTemp.Sort
.SetRange Range("G3:G3" & UBound(arrResult_OR, 1) + 4)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
TotalFile 7, "G3"

End Sub

[/GPECODE]

Mong các sư phụ chỉ giáo.

Xin Cám ơn rất nhiều.

Hoàng Trọng Nghĩa · 16/11/13

thnghiachau đã viết:
Chào các Thầy trên GPE,

Mình có chút vấn đền nhỏ không biết như thế nào... làm mãi vẫn không đúng.
Vui lòng xem file đính kèm.

Mong các sư phụ chỉ giáo.

Xin Cám ơn rất nhiều.

Mục đích của bạn là làm cái gì vậy bạn? Có phải bạn muốn tổng hợp 2 cột Data1 và Data2 rồi lọc duy nhất và gán cho cột Kết quả OR hay không?

thnghiachau · 16/11/13

Hoàng Trọng Nghĩa đã viết:
Mục đích của bạn là làm cái gì vậy bạn? Có phải bạn muốn tổng hợp 2 cột Data1 và Data2 rồi lọc duy nhất và gán cho cột Kết quả OR hay không?

Dạ đúng rùi ah...
nhưng cái mục đích này chỉ là "cái cớ" để nghiên cứu DICTIONARY , và MẢNG mà thôi.
Hiện tại mình "kẹt" vấn đề "GÁN GIÁ TRỊ Dic.Keys VÀO MẢNG, Và GHI MẢNG NÀY LÊN SHEET.
VIỆC GHI CỦA MÌNH KHÔNG THÀNH CÔNG (Code màu đó). nếu ghi bằng lệnh FOR thì OK nhưng thời gian làm rất là lâu!!!
vậy bạn có thể giúp mình ghi mảng được gán từ Dic.Keys lên Sheet không ah...
Cám ơn bạn nhiều.

Hoàng Trọng Nghĩa · 16/11/13

thnghiachau đã viết:
Dạ đúng rùi ah...
nhưng cái mục đích này chỉ là "cái cớ" để nghiên cứu DICTIONARY , và MẢNG mà thôi.
Hiện tại mình "kẹt" vấn đề "GÁN GIÁ TRỊ Dic.Keys VÀO MẢNG, Và GHI MẢNG NÀY LÊN SHEET.
VIỆC GHI CỦA MÌNH KHÔNG THÀNH CÔNG (Code màu đó). nếu ghi bằng lệnh FOR thì OK nhưng thời gian làm rất là lâu!!!
vậy bạn có thể giúp mình ghi mảng được gán từ Dic.Keys lên Sheet không ah...
Cám ơn bạn nhiều.

OK, chỉ vậy thôi thì quá dễ:

Mã:

Sub OneColumnUniqueArrays(ByRef UniqueArray(), _
                          ByRef RowCount As Long, _
                          ParamArray ManiOneColumnArrays())
                          
    Dim SubArray, EachItem, Dict As Object
    Set Dict = CreateObject("Scripting.Dictionary")
    
    For Each SubArray In ManiOneColumnArrays
        If Not IsArray(SubArray) Then SubArray = Array(SubArray)
        For Each EachItem In SubArray
            If Not IsEmpty(EachItem) And Not Dict.Exists(EachItem) Then
                Dict.Add EachItem, ""
            End If
        Next
    Next
    
    If Dict.Count Then
        UniqueArray = [COLOR=#ff0000][B]Application.WorksheetFunction.Transpose(Dict.Keys)[/B][/COLOR]
        RowCount = Dict.Count
    End If

    Set Dict = Nothing

End Sub


Sub Test()
    Dim UniqueArray(), RowCount As Long
    With Sheets("Temp")
        OneColumnUniqueArrays UniqueArray, RowCount, .Range("C4:C23"), .Range("E4:E25") 'Muon cot nao nua thi them vao
        .Range("G3:G65536").ClearContents
        .Range("G3") = RowCount & " pictures"
        .Range("G4").Resize(RowCount) = UniqueArray
    End With
End Sub

Bản thân Dict.Keys nó là mảng một chiều nên khi gán cho UniqueArray phải hoán vị cho nó.

Tất cả chỉ có vậy!

Hoàng Trọng Nghĩa · 16/11/13

Nếu bạn không muốn dùng dòng này:

UniqueArray = Application.WorksheetFunction.Transpose(Dict.Keys)

Tức không muốn dùng Hàm Application.WorksheetFunction.Transpose (hàm của Excel)

thì bạn có thể sửa lại như sau:

Mã:

Sub OneColumnUniqueArrays(ByRef UniqueArray(), _
                          ByRef RowCount As Long, _
                          ParamArray ManiOneColumnArrays())
                          
    Dim SubArray, EachItem, Dict As Object
    Set Dict = CreateObject("Scripting.Dictionary")
    
    For Each SubArray In ManiOneColumnArrays
        If Not IsArray(SubArray) Then SubArray = Array(SubArray)
        For Each EachItem In SubArray
            If Not IsEmpty(EachItem) And Not Dict.Exists(EachItem) Then
                Dict.Add EachItem, ""
            End If
        Next
    Next
    
[COLOR=#0000ff]    RowCount = Dict.Count[/COLOR]

[COLOR=#0000ff]    If RowCount Then[/COLOR]
[COLOR=#0000ff]        Dim r As Long, DictKeys()[/COLOR]
[COLOR=#0000ff]        DictKeys = Dict.Keys[/COLOR]
[COLOR=#0000ff]        ReDim UniqueArray(1 To RowCount, 1 To 1)[/COLOR]
[COLOR=#0000ff]        For r = 1 To RowCount[/COLOR]
[COLOR=#0000ff]            UniqueArray(r, 1) = DictKeys(r - 1)[/COLOR]
[COLOR=#0000ff]        Next[/COLOR]
[COLOR=#0000ff]    End If
[/COLOR]
    Set Dict = Nothing

End Sub

Những chỗ màu xanh là sửa lại.

Bạn cũng nên bẫy lỗi cho trường hợp không có mục nào được lọc (tức là mảng rỗng):

Mã:

Sub Test()
    Dim UniqueArray(), RowCount As Long
    With Sheets("Temp")
        OneColumnUniqueArrays UniqueArray, RowCount, .Range("C4:C23"), .Range("E4:E25") 'Muon cot nao nua thi them vao
        .Range("G3:G65536").ClearContents
[COLOR=#0000ff]        If RowCount > 0 Then[/COLOR]
[COLOR=#0000ff]            .Range("G3") = RowCount & " pictures"[/COLOR]
[COLOR=#0000ff]            .Range("G4").Resize(RowCount) = UniqueArray[/COLOR]
[COLOR=#0000ff]        End If[/COLOR]
    End With
End Sub

thnghiachau · 17/11/13

Hoàng Trọng Nghĩa đã viết:

Nếu bạn không muốn dùng dòng này:

UniqueArray = Application.WorksheetFunction.Transpose(Dict.Keys)

Tức không muốn dùng Hàm Application.WorksheetFunction.Transpose (hàm của Excel)

thì bạn có thể sửa lại như sau:

Mã:

Sub OneColumnUniqueArrays(ByRef UniqueArray(), _
                          ByRef RowCount As Long, _
                          ParamArray ManiOneColumnArrays())
                          
    Dim SubArray, EachItem, Dict As Object
    Set Dict = CreateObject("Scripting.Dictionary")
    
    For Each SubArray In ManiOneColumnArrays
        If Not IsArray(SubArray) Then SubArray = Array(SubArray)
        For Each EachItem In SubArray
            If Not IsEmpty(EachItem) And Not Dict.Exists(EachItem) Then
                Dict.Add EachItem, ""
            End If
        Next
    Next
    
[COLOR=#0000ff]    RowCount = Dict.Count[/COLOR]

[COLOR=#0000ff]    If RowCount Then[/COLOR]
[COLOR=#0000ff]        Dim r As Long, DictKeys()[/COLOR]
[COLOR=#0000ff]        DictKeys = Dict.Keys[/COLOR]
[COLOR=#0000ff]        ReDim UniqueArray(1 To RowCount, 1 To 1)[/COLOR]
[COLOR=#0000ff]        For r = 1 To RowCount[/COLOR]
[COLOR=#0000ff]            UniqueArray(r, 1) = DictKeys(r - 1)[/COLOR]
[COLOR=#0000ff]        Next[/COLOR]
[COLOR=#0000ff]    End If
[/COLOR]
    Set Dict = Nothing

End Sub

Những chỗ màu xanh là sửa lại.

Bạn cũng nên bẫy lỗi cho trường hợp không có mục nào được lọc (tức là mảng rỗng):

Mã:

Sub Test()
    Dim UniqueArray(), RowCount As Long
    With Sheets("Temp")
        OneColumnUniqueArrays UniqueArray, RowCount, .Range("C4:C23"), .Range("E4:E25") 'Muon cot nao nua thi them vao
        .Range("G3:G65536").ClearContents
[COLOR=#0000ff]        If RowCount > 0 Then[/COLOR]
[COLOR=#0000ff]            .Range("G3") = RowCount & " pictures"[/COLOR]
[COLOR=#0000ff]            .Range("G4").Resize(RowCount) = UniqueArray[/COLOR]
[COLOR=#0000ff]        End If[/COLOR]
    End With
End Sub

Cám Ơn Bạn rất nhiều, mình đã hiểu và làm được rùi. Vậy là biết thêm được là mảng của Dic.Keys là như thế nào...

cartoon18 · 19/11/13

Ba Tê đã viết:
Thì cứ dùng mảng Arr() đó, gán sheet1 vào rồi, gán tiếp sheet2 vào với k=k+1 tiếp tục, xong rồi hãy gán vào sheet4 1 lần.

dạ vấn đề là ở chỗ này đó , em mới biết về mảng nên còn mơ hồ lắm, đoạn code trên em làm được là dựa vào các bài trước mọi người thảo luận đó ah, tuy làm ra kết quả nhưng mà vẫn chưa hiểu rõ lắm cho nên em không biết làm thế nào để chỉ dùng 1 Arr() mà gán sheet1 vào rồi lại gán tiếp sheet2 vào @_@ xong rồi mới gán vào sheet4 cùng một lúc, nếu được Mong Bro chỉ cho em chi tiết hơn một chút nữa không ah.

Ba Tê · 19/11/13

cartoon18 đã viết:
dạ vấn đề là ở chỗ này đó , em mới biết về mảng nên còn mơ hồ lắm, đoạn code trên em làm được là dựa vào các bài trước mọi người thảo luận đó ah, tuy làm ra kết quả nhưng mà vẫn chưa hiểu rõ lắm cho nên em không biết làm thế nào để chỉ dùng 1 Arr() mà gán sheet1 vào rồi lại gán tiếp sheet2 vào @_@ xong rồi mới gán vào sheet4 cùng một lúc, nếu được Mong Bro chỉ cho em chi tiết hơn một chút nữa không ah.

Bạn chờ "Bro" đi.
Tui thì vừa già vừa dốt không biết "Bro" là cái gì. Nếu làm giúp bạn thì tui là "Bro" sao?
Híc. Tiếng Việt nhiều khi tui còn hổng hiểu.

cartoon18 · 25/11/13

Ba Tê đã viết:
Bạn chờ "Bro" đi.
Tui thì vừa già vừa dốt không biết "Bro" là cái gì. Nếu làm giúp bạn thì tui là "Bro" sao?
Híc. Tiếng Việt nhiều khi tui còn hổng hiểu.

ui trời cái tội sử dụng tiếng lóng sửa mãi không chừa +-+-+-+

em thành thật xin lỗi , lâu nay ra tiệm net toàn chơi game nên mới bị nhiễm mấy thứ ngôn ngữ này +-+-+-+

Mong các thầy trên diễn đàn chỉ bảo thêm ạ ! em xin chân thành cảm ơn !

pubreg · 25/11/13

Hi các a/c.
Giúp mình trường hợp sau:
có 1 mảng (range) là số có sắp xếp từ nhỏ tới lớn và không có giá trị trùng nhau, mình muốn dùng VBA để tìm giá trị trong mảng đó gần nhất với 1 giá trị cho trước (lớn hơn hoặc nhỏ hơn).
ví dụ mảng: 12,25,29,35,43,55,60
Giá trị cho trước: là 30 kết quả là 29, là 33 kết quả là 35.

Trân trọng cảm ơn.

Quang_Hải · 25/11/13

pubreg đã viết:
Hi các a/c.
Giúp mình trường hợp sau:
có 1 mảng (range) là số có sắp xếp từ nhỏ tới lớn và không có giá trị trùng nhau, mình muốn dùng VBA để tìm giá trị trong mảng đó gần nhất với 1 giá trị cho trước (lớn hơn hoặc nhỏ hơn).
ví dụ mảng: 12,25,29,35,43,55,60
Giá trị cho trước: là 30 kết quả là 29, là 33 kết quả là 35.

Trân trọng cảm ơn.

Tham khảo code này. Tuy nhiên để xài được chắc phải sửa lại nhiều

PHP:

Sub test()
Dim Sarr(), Dk, I
Sarr = Array(12, 25, 39, 43, 55, 60, 76, 85)
Dk = 30
Do
   If Sarr(I) > Dk Then
      MsgBox "So lon hon là: " & Sarr(I)
      If Sarr(I - 1) <> Dk Then
         MsgBox "So nho hon là: " & Sarr(I - 1)
      Else
         MsgBox "So nho hon là: " & Sarr(I - 2)
      End If
      Exit Do
   End If
   I = I + 1
Loop Until I > UBound(Sarr)
End Sub

VetMini · 25/11/13

pubreg đã viết:
Hi các a/c.
Giúp mình trường hợp sau:
có 1 mảng (range) là số có sắp xếp từ nhỏ tới lớn và không có giá trị trùng nhau, mình muốn dùng VBA để tìm giá trị trong mảng đó gần nhất với 1 giá trị cho trước (lớn hơn hoặc nhỏ hơn).
ví dụ mảng: 12,25,29,35,43,55,60
Giá trị cho trước: là 30 kết quả là 29, là 33 kết quả là 35.

Trân trọng cảm ơn.

Đề bài dỏm. Nếu số nằm ngay giữa 2 phần tử của mảng thì chọn trị nào?

Thường thường tìm trong mảng có sắp xếp thì người ta dùng giải thuật tìm nhị phân (binary search), và dùng hàm đệ quy.

code sau đây giả định nếu nằm giữa 2 phần tử thì chọn phần tử trước

Mã:

Sub t()
Dim Sarr()
Sarr = Array(12, 25, 39, 43, 55, 60, 76, 85)
Debug.Print TriGanNhat(30, Sarr, LBound(Sarr), UBound(Sarr))
End Sub


Function TriGanNhat(ByVal tri As Integer, ByRef mang() As Variant, ByVal dau As Integer, ByVal duoi As Integer) As Integer
' hàm đệ quy tìm giá trị gần nhất trong một mảng
If dau + 1 >= duoi Then ' chỉ còn 2 điểm, như vậy 1 trong 2 phải là đáp số
If tri <= (mang(dau) + mang(duoi)) / 2 Then TriGanNhat = mang(dau) Else TriGanNhat = mang(duoi)
Exit Function
End If
Dim giua As Integer ' điểm giữa chia mảng thành 2 đoạn
giua = (dau + duoi) / 2
If tri = mang(giua) Then ' tìm được trị chính xác
TriGanNhat = mang(giua)
ElseIf tri > mang(giua) Then
TriGanNhat = TriGanNhat(tri, mang, giua, duoi) ' đáp số nằm ở đoạn 2, tiếp tục dò
Else
TriGanNhat = TriGanNhat(tri, mang, dau, giua) ' đáp số nằm ở đoạn 1, tiếp tục dò
End If
End Function

siwtom · 26/11/13

VetMini đã viết:
Đề bài dỏm. Nếu số nằm ngay giữa 2 phần tử của mảng thì chọn trị nào?

Thường thường tìm trong mảng có sắp xếp thì người ta dùng giải thuật tìm nhị phân (binary search), và dùng hàm đệ quy.

code sau đây giả định nếu nằm giữa 2 phần tử thì chọn phần tử trước

Mã:

Sub t() Dim Sarr() Sarr = Array(12, 25, 39, 43, 55, 60, 76, 85) Debug.Print TriGanNhat(30, Sarr, LBound(Sarr), UBound(Sarr)) End Sub Function TriGanNhat(ByVal tri As Integer, ByRef mang() As Variant, ByVal dau As Integer, ByVal duoi As Integer) As Integer ' hàm đệ quy tìm giá trị gần nhất trong một mảng If dau + 1 >= duoi Then ' chỉ còn 2 điểm, như vậy 1 trong 2 phải là đáp số If tri <= (mang(dau) + mang(duoi)) / 2 Then TriGanNhat = mang(dau) Else TriGanNhat = mang(duoi) Exit Function End If Dim giua As Integer ' điểm giữa chia mảng thành 2 đoạn [B][COLOR=#ff0000]giua = (dau + duoi) / 2[/COLOR][/B] If tri = mang(giua) Then ' tìm được trị chính xác TriGanNhat = mang(giua) ElseIf tri > mang(giua) Then TriGanNhat = TriGanNhat(tri, mang, giua, duoi) ' đáp số nằm ở đoạn 2, tiếp tục dò Else TriGanNhat = TriGanNhat(tri, mang, dau, giua) ' đáp số nằm ở đoạn 1, tiếp tục dò End If End Function

Cần nhớ là việc thực hiện code đơn giản vd. k = (a + b) / 2 là quá trình tính từng bước. Bộ vi xử lý hay việc tính toán trên giấy bằng tay cũng thế, không thể đồng thời thực hiện phép cộng và chia được.
Trước hết phép cộng (a + b) được thực hiện và kết quả đó được nhớ tạm "ở đâu đó". Sau đó mới thực hiện phép chia giá trị "ở đâu đó" cho 2 và trả về kết quả. Phải rất thận trọng vì dễ quên và kết quả trung gian sẽ vượt quá giới hạn.

Khi tính vd. (a + b) thì kết quả trung gian sẽ được gán cho kiểu có giới hạn rộng nhất trong a và b. Tức nếu a as Integer và b As Long thì kết quả trung gian sẽ được gán cho kiểu Long. Nhưng nếu cũng có b As Integer thì kết quả trung gian sẽ được gán cho kiểu Integer.

Ta xét code

Mã:

Dim k as integer, a as Integer, b as Integer
a = 16000
b = 32000
k = (a + b) / 2
Msgbox k

Rõ ràng giá trị k = 24000 nằm trong giới hạn của Integer. a và b cũng thế.
Nhưng Run code sẽ có lỗi tại dòng k = (a + b) / 2. Vì sao? Vì khi tính (a + b) thì kết quả trung gian này sẽ được gán cho kiểu Integer do a và b đều là kiểu Integer. Nhưng kết quả trung gian này lại có giá trị 48000, tức vượt quá giới hạn của kiểu Integer. Do vậy có lỗi Overflow

Phải rất chú ý vì nhiều khi mọi biến "tham gia" trong phép toán (ở trên là a và b) đều có giá trị không vượt quá giới hạn của kiểu của chúng nhưng phép toán lại có lỗi Overflow

Như vậy chỗ đỏ đỏ sẽ có lỗi overflow một khi nào đó.

Vd. sẽ có lỗi overflow ở dòng đỏ đỏ (ở lần gọi hàm lần thứ hai, tức khi dau = 16000 và duoi = 32000) nếu có code

Mã:

Sub t()
Dim Sarr()
    ReDim Sarr(1 To 32000)
    For k = 1 To 32000
        Sarr(k) = k
    Next
    Debug.Print TriGanNhat(16001, Sarr, LBound(Sarr), UBound(Sarr))
End Sub

---------------
Ngoài ra với kiểu của trị là Integer mà chủ chủ đề có mảng 12, 25, 139, 2343, 1055, 32234, 36789, 40085 và muốn tìm giá trị 35000 thì không dùng hàm trên được rồi. Cái mảng và giá trị cần tìm mà chủ chủ đề đưa ra chỉ là ví dụ thôi

ví dụ mảng: 12,25,29,35,43,55,60
Giá trị cho trước: là 30

chứ có chỗ nào nói là Integer đâu.

Nếu sửa thành Byval tri As Long thì khi chạy code sẽ có lỗi overflow. Vì chắc chắn giá trị 36789 sẽ được tìm thấy nhưng TriGanNhat lại chỉ có kiểu Integer.

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

Tôi thử không dùng đệ quy. Vì đệ quy luôn là tốn thêm bộ nhớ - do các địa chỉ trở về, giá trị các biến phải được ghi vào bộ nhớ (stack) và được "lấy lại" khi hàm trở về. Đặc biệt tốn bộ nhớ khi "độ sâu" đệ quy càng lớn.

Mã:

Sub test()
Dim Sarr()
    ReDim Sarr(1 To 32000)
    For k = 1 To 32000
        Sarr(k) = k
    Next
    Debug.Print NearestValue(16001.6, Sarr)
'    Sarr = Array(12, 25, 139, 2343, 1055, 32234, 36789, 40085)
'    Debug.Print NearestValue(35000, Sarr)
End Sub

Function NearestValue(ByVal find_value As Double, mang()) As Double
Dim index As Long, Lo As Long, Hi As Long
    Lo = LBound(mang)
    Hi = UBound(mang)
    If find_value < mang(Lo) Or find_value > mang(Hi) Then
        MsgBox "Khong tim thay gia tri!"
        Exit Function
    End If
    index = (Lo + Hi) \ 2
    Do While mang(index) <> find_value
        If index = Lo Then Exit Do
        If mang(index) < find_value Then
            Lo = index
        Else
            Hi = index
        End If
        index = (Lo + Hi) \ 2
    Loop
    If mang(index) = find_value Then
        NearestValue = find_value
    Else
        If 2 * find_value <= mang(Lo) + mang(Hi) Then
            NearestValue = mang(Lo)
        Else
            NearestValue = mang(Hi)
        End If
    End If
End Function

Nếu ai test thấy sai sót thì xin góp ý. Chuyện nhầm lẫn là chuyện thường, ai cũng có thể mắc phải. Chỉ có điều sự đời nó là thế này: "Cái lỗi của người khác nhìn cứ như con voi ấy, rõ mồn một. Nhưng cũng lỗi ấy của bản thân thì nhìn nó như con kiến ấy, tìm đi tìm lại mà chả thấy."

VetMini · 26/11/13

1. Tuỳ theo ngôn ngữ mà chuyện tràn số tính khác nhau. Nếu là ngôn ngữ cấp dưới như C/C++ chẳng hạn thì tràn số cho kết quả sai (không nảy sinh error mà chỉ cắt bớt số bits của kết quả). Theo dòng họ BASIC thì tràn số sẽ bị error cho nên cũng không quan trọng lắm. Ở đây đâu có nói chuyện phóng phi thuyền lên vũ trụ. Cách tránh tràn số có hơi phức tạp.

2. Đệ quy tốn bộ nhớ và thời gian kết nối. Điều đó ai sử dụng đệ quy cũng phải biết. Tuỳ theo mức độ trầm trọng của vấn đề mà chúng ta có dùng nó hay không. (chú ý từ "trầm trọng" thay vì "quan trọng")

pubreg · 27/11/13

Cảm ơn các bác đã giúp đỡ.
Mảng của mình khoảng 2000 giá trị và mình muốn viết thành là function để tìm kiếm. Không biết như thế thì có chậm không nhỉ

siwtom đã viết:
Cần nhớ là việc thực hiện code đơn giản vd. k = (a + b) / 2 là quá trình tính từng bước. Bộ vi xử lý hay việc tính toán trên giấy bằng tay cũng thế, không thể đồng thời thực hiện phép cộng và chia được.

VetMini · 27/11/13

pubreg đã viết:
...
Mảng của mình khoảng 2000 giá trị và mình muốn viết thành là function để tìm kiếm. Không biết như thế thì có chậm không nhỉ

Đỏ:
Xét lại yêu cầu: tìm một giá trị
Thực tế: Trả về một giá trị là nhiệm vụ của function. Nếu không thì nguời ta đã dùng sub cho khoẻ.
Suy ra: đề bài này dùng function là đúng rồi. Không có cách nào hay hơn nữa.
Tuy nhiên: như tôi đã nói. Chi tiết đề dỏm. Nếu trị dò tìm nằm chính giữa hai trị trong mảng thì lấy lớn hay nhỏ?

Xanh:
Chậm và nhanh không phải là ưu tiên của tôi. Cái này để người khác trả lời. Toi chỉ có thể nói là phương pháp nhị phân chính là để giúp tăng hiệu quả so với cách tìm tuần tự từ đầu mảng.
Khi lập trình ưu tiên của tôi nằm ở kết quả nhìn vào có dễ kiểm soát là đúng hay sai hay không.
Tôi làm việc với dữ liệu nhiều năm. Kinh nghiệm cho biết cái đáng sợ nhất là kết quả sai nhưng không hiện rõ, vài ba tháng/năm sau mới té ra mình dùng dữ liệu sai bét.

doveandrose · 29/12/13

For và For each trong đoạn này khác nhau ở đâu ?

xin giúp đỡ em giữa 2 đoạn code

Mã:

Private Type HocSinh
tuoi As Integer
ten As String
End Type

đoạn code này

Mã:

Dim t(1 To 6) As HocSinh
Dim i As Integer
For i = 1 To 6 Step 1
t(i).ten = "abc"
Next

được chấp nhận còn đoạn code này

Mã:

Dim hs As HocSinh
Dim t(1 To 6) As HocSinh
For Each hs In t
hs.ten = "abc"
Next

lại báo lỗi " for each control variable on arrays must be variant "
cái em cần là sử dụng For each vì em xài mảng động
xin cho em biết phải sửa lại ntn
và xin cho biết cách đếm số phần tử hiện tại của 1 mảng động. Cảm ơn

Hoàng Trọng Nghĩa · 29/12/13

doveandrose đã viết:
xin giúp đỡ em giữa 2 đoạn code

Mã:

Private Type HocSinh tuoi As Integer ten As String End Type

đoạn code này

Mã:

Dim t(1 To 6) As HocSinh Dim i As Integer For i = 1 To 6 Step 1 t(i).ten = "abc" Next

được chấp nhận còn đoạn code này

Mã:

Dim hs As HocSinh Dim t(1 To 6) As HocSinh For Each hs In t hs.ten = "abc" Next

lại báo lỗi " for each control variable on arrays must be variant "
cái em cần là sử dụng For each vì em xài mảng động
xin cho em biết phải sửa lại ntn
và xin cho biết cách đếm số phần tử hiện tại của 1 mảng động. Cảm ơn

For Each có thể không được sử dụng trên mảng của Type người dùng định nghĩa hoặc các chuỗi dài cố định (For Each may not be used on array of user-defined type or fixed-length strings). Vì thế trong trường hợp này bạn không nên dùng nó.

Cách tính cận trên (Ubound) và cận dưới (Lbound) của mảng sau đó lấy cận trên trừ cho cận dưới cộng thêm 1 là ra số phần tử trong mảng.

Số phần tử = Ubound(YourArray) - Lbound(YourArray) + 1

giang140387 · 17/1/14

Các anh cho e hỏi. E có 1 mãng từ A1:A10. Em muốn tìm giá trị của cell B1 trong mãng nói trên nếu có thì xuất giá trị đó vào cell C1. Em phải code như thế nào vậy các anh

Các câu hỏi về mảng trong VBA (Array)

Thành viên gắn bó

Cạo Rồi Khỏi Gội

Supreme Сasual Dating - Real-life Girls

File đính kèm

Chuyên gia GPE

Supreme Сasual Dating - Real-life Girls

Chuyên gia GPE

Chuyên gia GPE

Supreme Сasual Dating - Real-life Girls

Thành viên chính thức

Cạo Rồi Khỏi Gội

Thành viên chính thức

Thành viên mới

Thành viên gạo cội

Ăn cùng góc phố

Thành viên gắn bó

Ăn cùng góc phố

Thành viên mới

Ăn cùng góc phố

hello

Chuyên gia GPE

Thành viên mới

Facebook

Group