Dùng Code nào để cho ra kết quả là tỷ giá gần nhất của 1 ngày

[cadafi]

Chào các anh chị,
Em có một vấn đề sau:
Em có một danh mục tỉ giá theo ngày như sau:

|

A​

|

B​

|

C​

|

D​

|

1​

|

CURY ID​

|

RATE DATE​

|

BASE CURY ID​

|

CURY RATE​

|

2​

|USD|

01/01/2008​

|VND|

16590​

|

3​

|DKK|

01/01/2008​

|USD|

5.7​

|

4​

|USD|

12/09/2008​

|VND|

17890​

|

5​

|USD|

14/09/2008​

|VND|

17891​

|

6​

|USD|

16/09/2008​

|VND|

17892​

|

7​

|USD|

18/09/2008​

|VND|

17893​

|

8​

|USD|

20/09/2008​

|VND|

17894​

|

9​

|USD|

22/09/2008​

|VND|

17895​

|

10​

|USD|

24/09/2008​

|VND|

17896​

|

11​

|USD|

26/09/2008​

|VND|

17897​

|

12​

|USD|

28/09/2008​

|VND|

17898​

|

13​

|USD|

30/09/2008​

|VND|

17899​

|

14​

|USD|

02/10/2008​

|VND|

17900​

|

15​

|USD|

04/10/2008​

|VND|

17901​

|

16​

|USD|

06/10/2008​

|VND|

17902​

|

17​

|USD|

08/10/2008​

|VND|

17903​

|

18​

|USD|

10/10/2008​

|VND|

17904​

|

19​

|USD|

12/10/2008​

|VND|

17905​

|<== Lấy tỷ giá này

20​

|USD|

14/10/2008​

|VND|

17906​

|

21​

|USD|

16/10/2008​

|VND|

17907​

|

22​

|USD|

18/10/2008​

|VND|

17908​

|

23​

|USD|

20/10/2008​

|VND|

17909​

|

24​

|USD|

22/10/2008​

|VND|

17910​

|

25​

|USD|

24/10/2008​

|VND|

17911​

|

26​

|USD|

26/10/2008​

|VND|

17912​

|

27​

|USD|

28/10/2008​

|VND|

17913​

|

Khi ta chọn một ngày bất kỳ, macro sẽ chọn ra tỷ giá của ngày gần nhất (Ngày tỷ giá <= ngày tham chiếu)
Ví dụ: Khi ta chọn ngày 13/10/2008 thì ngày gần nhất trong danh mục là ngày 12/10/2008 ==> lấy tỷ giá 17.905 điền vào 1 ô nào đó.
Xin các anh chị xem file đính kèm.
Xin các anh chị cho em giải pháp bằng VBA càng gọn càng tốt! Em xin cảm ơn!

 

[ndu96081631]

Hehe! Cái vụ SpecialCells mà em quên hoài! Cảm ơn anh ndu!
Tuy nhiên, không biết khi AutoFilter nó lại không ra như ý muốn, có lẽ điều kiện ngày có vấn đề, mong anh sửa giúp
[highlight=vb]
Sub GetExcRate1()
Dim mDate As Date
Dim CuryID As String, BaseCuryID As String
Dim rngExcRate As Range, ExcRate As Double
Dim mRng As Range, mCell As Range, MaxRow As Long, iR As Long
'---------------------------------------------------
mDate = Sheet1.[C1] 'Sheet1.[C1] đã được format dạng ngày "dd/mm/yyyy"
CuryID = Sheet1.[C2]
BaseCuryID = Sheet1.[C3]
MaxRow = Sheet1.[A65536].End(xlUp).Row
'---------------------------------------------------
Set rngExcRate = Sheet1.[C4]
Set mRng = Sheet1.Range("A6" & MaxRow)
'---------------------------------------------------
'Kiểm tra xem sheet có Autofilter chưa:
If Sheet1.AutoFilterMode = True Then Sheet1.AutoFilterMode = False
'---------------------------------------------------
'Autofilter:
mRng.AutoFilter Field:=1, Criteria1:=CuryID
mRng.AutoFilter Field:=2, Criteria1:="<=" & mDate
mRng.AutoFilter Field:=3, Criteria1:=BaseCuryID
'---------------------------------------------------
For Each mCell In Sheet1.Range("A6:A" & MaxRow).SpecialCells(12)
If (mCell = CuryID) And (mCell.Offset(, 1) <= mDate) And (mCell.Offset(, 2) = BaseCuryID) Then
ExcRate = mCell.Offset(, 3).Value
End If
Next mCell
rngExcRate.Value = ExcRate
End Sub
[/highlight]

Thử sửa
Criteria1:="<=" & mDate
thành
Criteria1:="<=" & CDbl(mDate)
Vụ này đã nói mấy lần rồi mà

 

[cadafi]

Thử sửa
Criteria1:="<=" & mDate
thành
Criteria1:="<=" & CDbl(mDate)
Vụ này đã nói mấy lần rồi mà

Cảm ơn anh, giờ code chạy ngon rồi! Cảm ơn anh nhiều nhiều! Đúng là em càng học càng ngu!

 

[cadafi]

Em mới nghĩ ra thêm một bước nữa không dùng For...next gì cả.
Nếu ta sort dữ liệu trước, sau đó autofilter và lồng hai cái specialcells vào nhau, đại khái là
Specialcells(xlCellTypeVisible).Specialcells(xlCellTypeLastCell).
[highlight=vb]
Sub GetExcRate1()
Dim mDate As Date
Dim CuryID As String, BaseCuryID As String
Dim rngExcRate As Range
Dim mRng As Range, mCell As Range, MaxRow As Long, iR As Long
'---------------------------------------------------
mDate = DateSerial(Year(Sheet1.[C1]), Month(Sheet1.[C1]), Day(Sheet1.[C1]))
CuryID = Sheet1.[C2]
BaseCuryID = Sheet1.[C3]
MaxRow = Sheet1.[A65536].End(xlUp).Row
'---------------------------------------------------
Set rngExcRate = Sheet1.[C4]
Set mRng = Sheet1.Range("A6" & MaxRow)
'---------------------------------------------------
'Kiem tra xem da autofilter chua:
If Sheet1.AutoFilterMode = True Then Sheet1.AutoFilterMode = False
'Sort Du lieu truoc khi tim:
mRng.Sort Key1:=Range("A7"), Order1:=xlAscending, Key2:=Range("B7") _
, Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
:=xlSortNormal
'---------------------------------------------------
'Autofilter:
mRng.AutoFilter Field:=1, Criteria1:=CuryID
mRng.AutoFilter Field:=2, Criteria1:="<=" & CDbl(mDate)
mRng.AutoFilter Field:=3, Criteria1:=BaseCuryID
'---------------------------------------------------
rngExcRate.Value = Sheet1.Range("A6:A" & MaxRow).SpecialCells(12).SpecialCells(xlCellTypeLastCell).Value
End Sub
[/highlight]

 

[ndu96081631]

Em mới nghĩ ra thêm một bước nữa không dùng For...next gì cả.
Nếu ta sort dữ liệu trước, sau đó autofilter và lồng hai cái specialcells vào nhau, đại khái là
Specialcells(xlCellTypeVisible).Specialcells(xlCellTypeLastCell).
[highlight=vb]
Sub GetExcRate1()
Dim mDate As Date
Dim CuryID As String, BaseCuryID As String
Dim rngExcRate As Range
Dim mRng As Range, mCell As Range, MaxRow As Long, iR As Long
'---------------------------------------------------
mDate = DateSerial(Year(Sheet1.[C1]), Month(Sheet1.[C1]), Day(Sheet1.[C1]))
CuryID = Sheet1.[C2]
BaseCuryID = Sheet1.[C3]
MaxRow = Sheet1.[A65536].End(xlUp).Row
'---------------------------------------------------
Set rngExcRate = Sheet1.[C4]
Set mRng = Sheet1.Range("A6" & MaxRow)
'---------------------------------------------------
'Kiem tra xem da autofilter chua:
If Sheet1.AutoFilterMode = True Then Sheet1.AutoFilterMode = False
'Sort Du lieu truoc khi tim:
mRng.Sort Key1:=Range("A7"), Order1:=xlAscending, Key2:=Range("B7") _
, Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
:=xlSortNormal
'---------------------------------------------------
'Autofilter:
mRng.AutoFilter Field:=1, Criteria1:=CuryID
mRng.AutoFilter Field:=2, Criteria1:="<=" & CDbl(mDate)
mRng.AutoFilter Field:=3, Criteria1:=BaseCuryID
'---------------------------------------------------
rngExcRate.Value = Sheet1.Range("A6:A" & MaxRow).SpecialCells(12).SpecialCells(xlCellTypeLastCell).Value
End Sub
[/highlight]

Sau khi Sort dử liệu rồi AutoFilter đúng điều kiện thì dòng ta cần lấy chính là dòng đầu sau khi AutoFilter
Nếu ta
Set Rng = ActiveSheet.AutoFilter.Range
thì
Rng.Offset(1).SpecialCells(12).Resize(1)
chính là dòng đầu tiên đấy

 

[ndu96081631]

Sau khi nghiên cứu kỹ bài này, tôi thấy chỉ cần 1 đoạn code ngắn thế này là đủ:

Option Explicit
Sub GetExcRate1()
 Dim Temp As Variant
 With Range("A6").CurrentRegion
   Temp = .Cells.Value
   .Sort .Cells(2, 2), 2, , Header:=1
   .AutoFilter 1, [C2]: .AutoFilter 2, "<=" & CDbl([C1]): .AutoFilter 3, [C3]
   [C4] = .Offset(1, 3).SpecialCells(12).Areas(1).Resize(1, 1)
   .AutoFilter
   .Value = Temp
 End With
End Sub

Đoan:
Temp = .Cells.Value
và
.Value = Temp
Có thể bỏ qua nếu ta không có nhu cầu trả dử liệu về vị trí ban đầu

 

[cadafi]

Code chạy tuyệt vời! Cảm ơn anh ndu96081631
Cái vụ SpecialCells(12).Areas(1).Resize(1, 1) em chưa hiểu lắm!

 

[ndu96081631]

Code chạy tuyệt vời! Cảm ơn anh ndu96081631
Cái vụ SpecialCells(12).Areas(1).Resize(1, 1) em chưa hiểu lắm!

Đương nhiên phải có Areas rồi ---> Vì sau khi ta Ctrl + G\Special\Visible Cell only thì vùng dử liệu được chọn sẽ là tất cả các cell đang "hiện" ---> Mà các cell này đôi lúc không nằm liền kề nhau (bị các dòng ẩn chia cắt) ---> Khi ấy nhưng vùng liền kề tạo thành 1 Area ---> Cả vùng Visible cell only này bao gồm nhiều Areas khác nhau
Nếu ta dùng
SpecialCells(12).Resize(1, 1)
Thì nó.. cóc chạy (không thể Resize các cell không liền kề )
Chỉ vậy thôi
Nói thêm:
Areas(1) là vùng thứ nhất
Areas(2) là vùng thứ hai
vân.. vân...
Và đương nhiên cell ta cần lấy nó đang nằm tại dòng thứ nhất của Areas(1)
Đơn giản thế thôi

 

[Mr Okebab]

Nếu chỉ có lấy 1 giá trị 1 lần mà phải dùng Sub thì e rằng hơi đao to búa lớn.
Nếu như trong DATA mà có công thức thì khi trở lại ban đầu công thức sẽ thay thế bởi giá trị, công thức sẽ bị xóa đi, và tỉ giá trả về sẽ là #VALUE
Sort thì rất nhanh, tuy nhiên khi làm với mảng dữ liệu lớn, đang Sort mà cúp điện đột ngột thì DATA sẽ bị hỏng (tôi đã từng bị trường hợp như thế khi dùng desktop)

Vì vậy yêu cầu của các bài toán về DATAbase là không đụng chạm đến DATA để bảo đảm tính toàn vẹn của nó.
Nếu có cách nào không đụng chạm đến DATA được không nhỉ??

Thân!

 

[ndu96081631]

đụng chạm đến DATA được không nhỉ??

Thân!

Đương nhiên là được ---> Theo tôi, cách đơn giản nhất là thêm 1 cột STT
Ta chẳng thay đổi gì dử liệu cả, sau khi Sort xong, muốn quay về từ đầu thì sẽ dựa vào cột STT này mà "xơi"
Ẹc... Ẹc...

 

[cadafi]

Nếu chỉ có lấy 1 giá trị 1 lần mà phải dùng Sub thì e rằng hơi đao to búa lớn.
Nếu như trong DATA mà có công thức thì khi trở lại ban đầu công thức sẽ thay thế bởi giá trị, công thức sẽ bị xóa đi, và tỉ giá trả về sẽ là #VALUE
Sort thì rất nhanh, tuy nhiên khi làm với mảng dữ liệu lớn, đang Sort mà cúp điện đột ngột thì DATA sẽ bị hỏng (tôi đã từng bị trường hợp như thế khi dùng desktop)

Vì vậy yêu cầu của các bài toán về DATAbase là không đụng chạm đến DATA để bảo đảm tính toàn vẹn của nó.
Nếu có cách nào không đụng chạm đến DATA được không nhỉ??

Thân!

Giải pháp không sort dữ liệu thì em có nói rồi đó anh, dùng For...Next. Tuy nhiên nếu dữ liệu nhiều thì For..Next lâu lắm!

 

[Po_Pikachu]

Không For..next thì dùng obj.Find(..) vậy?
Mọi người nghĩ sao?
Thân.

 

[ndu96081631]

Không For..next thì dùng obj.Find(..) vậy?
Mọi người nghĩ sao?
Thân.

Cái này thì sự phụ TQ đã làm rồi đấy (bài #5)... có điều khi ấy chưa tính tới việc lọc có thêm 2 điều kiện nữa: USD và VND

 

[cadafi]

Sau khi nghiên cứu kỹ bài này, tôi thấy chỉ cần 1 đoạn code ngắn thế này là đủ:

Option Explicit
Sub GetExcRate1()
 Dim Temp As Variant
 With Range("A6").CurrentRegion
   Temp = .Cells.Value
   .Sort .Cells(2, 2), 2, , Header:=1
  ...............
 End With
End Sub

Cho em hỏi tí, Tham số 2 trong cú pháp Sort có phải là Sort theo thứ tự từ lớn đến nhỏ không!?

 

[Mr Okebab]

Cho em hỏi tí, Tham số 2 trong cú pháp Sort có phải là Sort theo thứ tự từ lớn đến nhỏ không!?

Đó chính là XlSortOrder trong cú pháp Sort Method (1 :Tăng : xlAscending; 2 :Giảm : xlDescending)

Range.Sort Method
Sorts a range of values.
Syntax
expression.Sort(Key1, Order1, Key2, Type, Order2, Key3, Order3, Header, OrderCustom, MatchCase, Orientation, SortMethod, DataOption1, DataOption2, DataOption3)|||
expression A variable that represents a Range object.
Parameters

Name|Required/Optional|Data Type|Description
Key1|Optional|Variant|Specifies the first sort field, either as a range name (String) or Range object; determines the values to be sorted.
Order1|Optional|XlSortOrder|Determines the sort order for the values specified in Key1.
Key2|Optional|Variant|Second sort field; cannot be used when sorting a pivot table.
Type|Optional|Variant|Specified which elements are to be sorted.
Order2|Optional|XlSortOrder|Determines the sort order for the values specified in Key2.
Key3|Optional|Variant|Third sort field; cannot be used when sorting a pivot table.
Order3|Optional|XlSortOrder|Determines the sort order for the values specified in Key3.
Header|Optional|XlYesNoGuess|Specifies whether the first row contains header information. xlNo is the default value; specify xlGuess if you want Excel to attempt to determine the header.
OrderCustom|Optional|Variant|Specifies a one-based integer offset into the list of custom sort orders.
MatchCase|Optional|Variant|Set to True to perform a case-sensitive sort, False to perform non-case sensitive sort; cannot be used with pivot tables.
Orientation|Optional|XlSortOrientation|Specifies if the sort should be in acending or decending order.
SortMethod|Optional|XlSortMethod|Specifies the sort method.
DataOption1|Optional|XlSortDataOption|Specifies how to sort text in the range specified in Key1; does not apply to pivot table sorting.
DataOption2|Optional|XlSortDataOption|Specifies how to sort text in the range specified in Key2; does not apply to pivot table sorting.
DataOption3|Optional|XlSortDataOption|Specifies how to sort text in the range specified in Key3; does not apply to pivot table sorting.
|||

For . . Next là vét cạn, chả lẽ không có cái khác nhanh hơn sao ??
Em thử Find chưa?? EM hay dùng Find lắm mà. Hay một cái nào đó khác chẳng hạn.
Miễn là làm sao đừng đụng đến DATA, khi em giải quyết chương trình của em cho khách hàng thì mới thấy sự toàn vẹn của DATA quan trọng như thế nào.

Thân!

 

[ndu96081631]

Cho em hỏi tí, Tham số 2 trong cú pháp Sort có phải là Sort theo thứ tự từ lớn đến nhỏ không!?

Chính xác!
Cái này tôi "phăng ra" khi record macro ---> Cũng dể nhận biết lắm! Này nhé:
- Khi bạn record macro mà có gọi 1 cửa sổ lệnh nào đó, nếu trong cửa số này có 2 Option Button cho ta chọn thì ăn chắc 9/10 cái trên sẽ là 1, cái dưới là 2
- Nếu cửa sổ lệnh có CheckBox thì TRUE tương đương với Check, FALSE tương đương với UnCheck
- Nếu cửa sổ lệnh có ComboBox thì giá trị mà ta chọn là số tương ứng với số dòng mà giá trị ấy chứa trong ComboBox (ví dụ: ComboBox chứa 3 giá trị chọn là Vàng, Xanh, Đỏ thì nếu ta viết ComboBox = 2 sẽ tương đương với chọn màu xanh)
vân vân và vân vân
Ví dụ:
Range(....).AdvancedFilter 1,.... thì số 1 tương ứng với việc ta chọn Filter the list, in-place --> Là Option Button nằm trên
Range(....).AdvancedFilter 2,.... thì số 2 tương ứng với việc ta chọn Copy to another location --> Là Option Button nằm dưới
Vậy thôi ---> Chỉ là xảo thuật
Thêm nữa: Mấy chứ xlYes, xlNo, gì gì đó khiến tôi rất khó nhớ ---> Tôi cứ suy nó ra số cho dể (muốn biết số = bao nhiêu thì gọi cửa sổ lệnh ra mà đếm ---> Dể ẹt)

 

[Po_Pikachu]

Còn cái vụ .SpecialCells (..) thì sao?
Trong cùng 1 khung mà có rất nhiều trường hợp.
Ví dụ như chọn .CurrentRegion thì lại không nằm trong SpecialCells.
Điều đó thật là khó hiểu?
Thân.

 

[ndu96081631]

Còn cái vụ .SpecialCells (..) thì sao?
Trong cùng 1 khung mà có rất nhiều trường hợp.
Ví dụ như chọn .CurrentRegion thì lại không nằm trong SpecialCells.
Điều đó thật là khó hiểu?
Thân.

Cái gì cũng có mức chính xác tương đôi thôi Po à! 1 vài tùy chọn không tuân theo quy luật như tôi nói ở trên ---> MsgBox chẳng hạn
(bởi vậy ở trên tôi nói: ĂN CHẮC 9/10 ---> Đâu dám 10/10)
Ẹc... Ẹc...