trungvdb
Thành viên thường trực




- Tham gia
- 22/8/08
- Bài viết
- 374
- Được thích
- 171
- Nghề nghiệp
- Tài chính
Private Sub CommandButton1_Click()
'Xu ly trong mang:
Dim iRow As Long, MyArray, MyArr
Columns(2).ClearContents
MyArray = Range("A1", Range("A65536").End(xlUp)).Value
ReDim MyArr(1 To UBound(MyArray, 1), 1 To 1)
For iRow = 1 To UBound(MyArray, 1)
If MyArray(iRow, 1) > 0 Then MyArr(iRow, 1) = MyArray(iRow, 1)
Next
If IsArray(MyArr) Then Range("B1").Resize(UBound(MyArr, 1), 1).Value = MyArr
End Sub
Private Sub CommandButton2_Click()
'Xu ly tren sheet:
Dim MyRange As Range
Columns(2).ClearContents
For Each MyRange In Range("A1", Range("A65536").End(xlUp))
If MyRange.Value > 0 Then MyRange.Offset(, 1) = MyRange.Value
Next
End Sub
Cái này đơn giản nhất là cứ thử thao tác bằng tay sau đó ghi lại đoạn code đó.Khi đã hiểu được đoạn code đó rồi bạn có thể rút ngắn bớt đoạn tự động đó .Nếu em muốn kết quả cột B xếp liền với nhau (tức là không có ô trống nữa) thì làm thế nào bây giờ?
Private Sub CommandButton1_Click()
''Xu ly trong mang:
Dim iRow As Long, iCount As Long, MyArray, MyArr
Columns(2).ClearContents
MyArray = Range("A1", Range("A65536").End(xlUp)).Value
ReDim ResultArr(1 To UBound(MyArray, 1), 1 To 1)
For iRow = 1 To UBound(MyArray, 1)
If MyArray(iRow, 1) > 0 Then iCount = iCount + 1: ResultArr(iCount, 1) = MyArray(iRow, 1)
Next
If iCount > 0 Then Range("B1").Resize(iCount, 1).Value = ResultArr
End Sub
Private Sub CommandButton2_Click()
''Xu ly tren sheet:
Dim MyCell As Range, nR As Long
Columns(2).ClearContents
For Each MyCell In Range("A1", Range("A65536").End(xlUp))
If MyCell.Value > 0 Then
nR = [B65000].End(xlUp).Row
Cells(nR +1, 2) = MyCell.Value
End If
Next
End Sub
Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
With Range([A4], [A60000].End(xlUp))
.AutoFilter 1, ">0"
.SpecialCells(12).Copy Range("B4")
.AutoFilter
End With
Application.ScreenUpdating = True
End Sub
Bắt chước Minh Thien: Muốn kết quả cột B xếp liền nhau:
Xử lý bằng mảng:
PHP:Private Sub CommandButton1_Click() ''Xu ly trong mang: Dim iRow As Long, iCount As Long, MyArray, MyArr Columns(2).ClearContents MyArray = Range("A1", Range("A65536").End(xlUp)).Value ReDim ResultArr(1 To UBound(MyArray, 1), 1 To 1) For iRow = 1 To UBound(MyArray, 1) If MyArray(iRow, 1) > 0 Then iCount = iCount + 1: ResultArr(iCount, 1) = MyArray(iRow, 1) Next If iCount > 0 Then Range("B1").Resize(iCount, 1).Value = ResultArr End Sub
Xử lý trực tiếp trên sheet:
PHP:Private Sub CommandButton2_Click() ''Xu ly tren sheet: Dim MyCell As Range, nR As Long Columns(2).ClearContents For Each MyCell In Range("A1", Range("A65536").End(xlUp)) If MyCell.Value > 0 Then nR = [B65000].End(xlUp).Row Cells(nR +1, 2) = MyCell.Value End If Next End Sub
Em làm theo mọi người trên diễn đàn: Ấn Alt+F11, sau khi vào Insert/Modul/Copy đoạn của thày vào. Nhưng kích hoạt thế nào cho nó chạy hả thày?
Bắt chước Minh Thien: Muốn kết quả cột B xếp liền nhau:
Xử lý trực tiếp trên sheet:
PHP:Private Sub CommandButton2_Click() ''Xu ly tren sheet: Dim MyCell As Range, nR As Long Columns(2).ClearContents For Each MyCell In Range("A1", Range("A65536").End(xlUp)) If MyCell.Value > 0 Then nR = [B65000].End(xlUp).Row Cells(nR +1, 2) = MyCell.Value End If Next End Sub
Private Sub CommandButton1_Click()
''Xu ly tren sheet:
Dim MyCell As Range, nR As Long
Columns(2).ClearContents
For Each MyCell In Range("A1", Range("A65536").End(xlUp))
If MyCell.Value > 0 Then
nR = [B65000].End(xlUp).Row
If [COLOR=#0000cd][B][B1].Value = "" [/B][/COLOR]Then
[COLOR=#ff0000][B]Cells(nR, 2) = MyCell.Value[/B][/COLOR]
Else
Cells(nR + 1, 2) = MyCell.Value
End If
End If
Next
End Sub
Làm chi cả 1 cái If cho rắc rối sự đời:Hình như thủ tục này đã chưa gán giá trị tại B1, nên phải thêm chút xíu:
Mã:If [COLOR=#0000cd][B][B1].Value = "" [/B][/COLOR]Then [COLOR=#ff0000][B]Cells(nR, 2) = MyCell.Value[/B][/COLOR] Else Cells(nR + 1, 2) = MyCell.Value End If
Cells(nR + IIf(nR = 1, 0, 1),2) = MyCell.Value
For Each MyCell In Range("A1", Range("A65536").End(xlUp))
If MyCell.Value > 0 Then
iCount = iCount +1)
Cells(iCount, 2) = MyCell.Value
End If
Next
Chỉ là bài toán trích lọc có điều kiện thôiXin cảm ơn các thày, các anh, các chị đã quan tâm, giúp đỡ em rất nhiều.
Khi bước vào học VBA em hầu như chỉ biết đến các hàm Sum, Left...nói chung là những hàm đơn giản, được các thày tận tình chỉ bảo em đã bắt đầu vận dụng được vào công việc của mình.
Em dự định dành thời gian để cố gắng học sử dụng phối hợp các hàm trong Excel như Offset, Match..., bởi em thấy cách đó bổ trợ về thuật toán VBA rất nhiều. Em có đọc một số bài trên diễn đàn, nhưng em thấy hơi lúng túng khi sử dụng nhiều hàm lồng vào nhau (đặc biệt là anh chàng Indirect...)
Kính mong các thày, các anh, các chị giúp em tiếp cận bài toán chủ đề này bằng công thức Excel thông thường với ah.
Rất kính mong nhận được sự quan tâm, giúp đỡ.
Rng =OFFSET($A$5,,,MATCH(10^15,$A$5:$A$10000),)
Pos =IF(Rng>0,ROW(INDIRECT("1:"&ROWS(Rng))),"")
=IF(ROWS($1:1)>COUNT(Pos),"",INDEX(Rng, SMALL(Pos, ROWS($1:1))))
Hỏi ngược lại: Nếu bỏ hàm INDIRECT thì trong công thức này =IF(Rng>0,ROW($1:$?),"") dấu hỏi màu đỏ sẽ được thay bằng số mấy?Em cảm ơn thày, em đọc từ hôm qua các bài, em thấy quan trọng nhất bước là Đánh dấu vị trí dữ liệu nào ta cần lấy, tuy vậy em chưa hiểu cái hàm Indirect này lắm, em có thắc mắc tại bài http://www.giaiphapexcel.com/forum/showthread.php?2211-Hỏi-nhanh-đáp-nhanh-về-công-thức/page254 ,
Kính mong thày giúp cho./.
Em đã Test thử bỏ hàm Indirect thì em nhận thấy: Nếu bỏ Indirect đi thì thành phần bôi đỏ trong công thức ROW($1:$?) nó sẽ dịch chuyển tương đối, hay nói cách khác là Indirect có tác dụng đóng băng ($1:$?) lại, tựa như tham chiếu tuyệt đối vậy.Hỏi ngược lại: Nếu bỏ hàm INDIRECT thì trong công thức này =IF(Rng>0,ROW($1:$?),"") dấu hỏi màu đỏ sẽ được thay bằng số mấy?
Thì cũng giống như INDIRECT("A1") sẽ = cell A1Em đã Test thử bỏ hàm Indirect thì em nhận thấy: Nếu bỏ Indirect đi thì thành phần bôi đỏ trong công thức ROW($1:$?) nó sẽ dịch chuyển tương đối, hay nói cách khác là Indirect có tác dụng đóng băng ($1:$?) lại, tựa như tham chiếu tuyệt đối vậy.
Băn khoăn của em chỉ không hiểu ở chỗ: Tại sao Row(Indirect("1:1")) = Row(1:1) ah? nghĩa là tại sao Indirect("1:1") ,--> (1:1).
Vì dòng 1 có rất nhiều ô có giá trị khác nhau thì Indirect biết lấy giá trị ô nào (và tại sao nó lại cho kết quả vậy)
(Bởi em suy ra từ tham chiếu ô đơn của hàm này, ví dụ Indirect ("A5") = A5 = GPE (nếu ô 5 đánh chữ GPE)
Sub loc()
Dim DL(), KQ(), Dongdau As Long, i As Long, j As Long
Dongdau = 4
DL = Range("A" & Dongdau & ":A19").Value
Range("B:B").ClearContents
ReDim KQ(1 To UBound(DL, 1), 1 To 1)
For i = 1 To UBound(DL, 1)
If DL(i, 1) > 0 Then
j = j + 1
KQ(j, 1) = "=A" & (Dongdau + i)
End If
Next
[B1].Resize(j, 1).Value = KQ
End Sub
Xin làm phiền các thày chút, tôi đang học cách viết Code có link đầu vào và đầu ra (vì lý do sếp bắt phải làm thế), tôi viết chạy không đúng kết quả, rất mong các thày sửa giúp cho
PHP:Sub loc() Dim DL(), KQ(), Dongdau As Long, i As Long, j As Long Dongdau = 4 DL = Range("A" & Dongdau & ":A19").Value Range("B:B").ClearContents ReDim KQ(1 To UBound(DL, 1), 1 To 1) For i = 1 To UBound(DL, 1) If DL(i, 1) > 0 Then j = j + 1 KQ(j, 1) = "=A" & (Dongdau + i) End If Next [B1].Resize(j, 1).Value = KQ End Sub
Xin cho hỏi, bạn cần ở cột B là kết quả của cột A hay cần công thức?
Thì tôi đã nói rõ ở trên rồi mà bác nghĩa, cái tôi cần là kết quả như đầu bài của Topic chỉ có điều "có thêm" kết quả đầu ra Link với đầu vào, để dễ hình dung tôi điền trước kết quả vào file đính kèm nhờ bác giúp
Sub Test()
Dim Rng As Range, i As Long
Sheet1.Range("B:B").ClearContents
For Each Rng In Sheet1.Range("A4:A19")
If Rng.Value > 0 Then
i = i + 1
Sheet1.Range("B" & i).Formula = "=" & Rng.Address(0, 0)
End If
Next
End Sub
Sub loc()
Dim DL(), KQ(), Dongdau As Long, i As Long, j As Long
Dongdau = 4
DL = Sheet1.Range("A" & Dongdau & ":A19").Value
Sheet1.Range("B:B").ClearContents
ReDim KQ(1 To UBound(DL, 1), 1 To 1)
j = 0
For i = 1 To UBound(DL, 1)
If CDbl(DL(i, 1)) > 0 Then
j = j + 1
KQ(j, 1) = "=A" & (Dongdau + i - 1)
End If
Next
Sheet1.[B1].Resize(j, 1).Formula = KQ
End Sub
Sheet1.[B1].Resize(j, 1).Formula = KQ
Sub loc()
Dim DL(), KQ(), Dongdau As Long, i As Long, j As Long
Dongdau = 4
DL = Sheet1.Range("A" & Dongdau & ":A19").Value
Sheet1.Range("B:B").ClearContents
ReDim KQ(1 To UBound(DL, 1), 1 To 1)
j = 0
For i = 1 To UBound(DL, 1)
If DL(i, 1) > 0 Then
j = j + 1
KQ(j, 1) = "=A" & (Dongdau + i - 1)
End If
Next
Sheet1.[B1].Resize(j, 1) = KQ
End Sub
Tôi chưa hiểu CDbl trong đoạn Code của bác là gì? Mặt khác tôi thấy dòng "=A" & (Dongdau + i - 1) bản chất nó là chuỗi rồi thì dòngcó vẻ thừa (.Formula).PHP:Sheet1.[B1].Resize(j, 1).Formula = KQ
Vì tôi sửa như sau vẫn ổn mà bác
PHP:Sub loc() Dim DL(), KQ(), Dongdau As Long, i As Long, j As Long Dongdau = 4 DL = Sheet1.Range("A" & Dongdau & ":A19").Value Sheet1.Range("B:B").ClearContents ReDim KQ(1 To UBound(DL, 1), 1 To 1) j = 0 For i = 1 To UBound(DL, 1) If DL(i, 1) > 0 Then j = j + 1 KQ(j, 1) = "=A" & (Dongdau + i - 1) End If Next Sheet1.[B1].Resize(j, 1) = KQ End Sub
Tôi đang tìm hiểu phuơng thức find trong VBA, nhờ các bạn giúp tôi theo cách này để tôi hiểu rõ hơn. Xin đa tạ.
DL=Sheet1!$A$5:$A$19
DK=IF(DL>0;ROW(INDIRECT("1:"&ROWS(DL)));"")
IF(ROWS($1:1)>COUNT(DK);"";OFFSET(DL;SMALL(DK;ROWS($1:1))-1;;1;1))
Chỉ là bài toán trích lọc có điều kiện thôi
Cách làm như sau:
1> Đặt name xác định vùng dữ liệu:
2> Đặt name xác định vị trí các phần tử thỏa điều kiện:Mã:Rng =OFFSET($A$5,,,MATCH(10^15,$A$5:$A$10000),)
3> Công thức trích lọc:Mã:Pos =IF(Rng>0,ROW(INDIRECT("1:"&ROWS(Rng))),"")
--------------Mã:=IF(ROWS($1:1)>COUNT(Pos),"",INDEX(Rng, SMALL(Pos, ROWS($1:1))))
Gần như bài toán trích lọc nào cũng sẽ làm theo cách này, chỉ khác ở bước 2 (tùy theo điều kiện là gì)
Lookup() mà anh đã từng biết trong một số công thức không phải để thay cho Index() mà nó dùng để Remove giá trị lỗi thôi anh ạ. Không dùng Index() sao có thể trích lọc được dữ liệu ạ? Anh thử kiểm tra lại anh nhé! Đừng áp dụng máy móc như thế có ngày bị tẩu hỏa nhập ma đó.hic hicTrong công thức của thày =IF(ROWS($1:1)>COUNT(Pos),"",INDEX(Rng, SMALL(Pos, ROWS($1:1)))) nếu không dùng Index mà dùng Lookup liệu có được không ah?
Em chưa biết gì về VBA, nhờ mọi người giúp em tiếp cận với nó bằng bài toán lọc toàn bộ những số dương (>0) từ cột A sang cột B thì Code phải viết ra sao?
Sub xxx()
[a:a].Copy [b1]
[b:b].Replace "-*", ""
End Sub