Chuyên đề giải đáp những thắc mắc về code VBA (1 người xem)

[maytinhvp01]

Mình muốn nhờ giải thich câu lệnh " If Ran.Cells(d, c) > max Then max = Ran.Cells(d, c) "
trong ví du:
Public Function LonNhat(Ran As Range)
Dim max As Double, v As Integer, d As Integer, c As Integer
max = Ran.Cells(1, 1)
For d = 1 To Ran.Rows.Count
For c = 1 To Ran.Columns.Count
If Ran.Cells(d, c) > max Then max = Ran.Cells(d, c)
Next c
Next d
v = Tim(max, Ran)
LonNhat = max
End Function
-------------------------------------------------------
[INFO1]Thông báo:
Vì topic này:
http://www.giaiphapexcel.com/forum/...ải-thích-các-code-đề-nghị-các-bạn-gửi-vào-đây
đã quá dài nên BQT đóng lại.
Nay tôi mở topic mới với cùng chủ đề: GIẢI THÍCH NHỮNG THẮC MẮC VỀ CODE
Các bạn nếu có nhu cầu giải thích code, vui lòng post tại đây nhé
NDU96081631
[/INFO1]

 

[ndu96081631]

Sub abc(SH As Worksheet)
'.......................
'''''code
''''''''''
End Sub


Sub main()
Call abc(Sheet1) ' sheet1 là tên sheet trong cua so VBA
Call abc(Sheet2) ' sheet2 là tên sheet trong cua so VBA
Call abc(Sheet3) ' sheet3 là tên sheet trong cua so VBA
' xin cho hoi co cách nào goi duoc nhu the này khong
Call abc("sheet" & 1) ' chu y la lay ten sheet trong cua so VBA thoi nha
' khong lay ten sheet ben ngoai
End Sub
[B]Call abc("sheet" & 1) ' chu y la lay ten sheet trong cua so VBA thoi nha[/B]
[B]' khong lay ten sheet ben ngoai có được không?[/B]

xin cho hỏi là có cách nào làm được như trên không? xin chân thành cảm ơn

Dùng hàm CallByName

Sub Main()
  Call abc(CallByName(ThisWorkbook.Worksheets, "Item", VbGet,[COLOR=#ff0000] "Sheet" & 1[/COLOR]))
End Sub

Chỗ màu đỏ là đối số cho bạn tùy biến
----------------------------------

Bạn tham khảo cặp macro này thử coi:

Option Explicit
Sub GPE(Sh As Worksheet)
 MsgBox Sh.Name
End Sub

Sub Main()
 Dim ShName As String, J As Byte
 For J = 1 To 3
    GPE Worksheets("sheet" & CStr(J))
 Next J
End Sub

Cái đối số truyền vào người ta muốn là Sheet CodeName chứ hổng phải SheetName đâu sư phụ à

 

[phihndhsp]

Sao em thử áp dụng vào vấn đề này nó báo lỗi anh
Call Tong_HopNHAP(CallByName(ThisWorkbook.Worksheets, "Item", VbGet, "Sheet" & 1), ARR_D, K)
anh xem dùm em module3 thử sao nha, cảm ơn anh ndu nhiều, file này áp dụng để giảng dạy

 

[ndu96081631]

Sao em thử áp dụng vào vấn đề này nó báo lỗi anh
Call Tong_HopNHAP(CallByName(ThisWorkbook.Worksheets, "Item", VbGet, "Sheet" & 1), ARR_D, K)
anh xem dùm em module3 thử sao nha, cảm ơn anh ndu nhiều, file này áp dụng để giảng dạy

Chết! Tôi sai rồi. Đối số của hàm CallByName không phải là CodeName mà là SheetName
Vậy sửa thế này:

Sub MAIN02()
  Dim ARR_D(1 To 60000, 1 To 9)
  Dim K As Long
  K = 0
  Sheet40.Range("A6:Z10000").Clear
  [COLOR=#ff0000]Dim wkb As Workbook
  Set wkb = ThisWorkbook[/COLOR]
'For I = 1 To 34 Step 3
    Call Tong_HopNHAP([COLOR=#ff0000]wkb.Worksheets(wkb.VBProject.VBComponents([B]"Sheet" & 1[/B]).Properties("Name").Value)[/COLOR], ARR_D, K)
'Next
'Sheet40.Range("a6").Resize(K, 9) = ARR_D
End Sub

Chỗ màu đỏ là thêm vào và sửa lại
-------------
Vậy bài 311 cũng phải sửa lại:

Sub Main()
  [COLOR=#ff0000]Dim wkb As Workbook
  Set wkb = ThisWorkbook[/COLOR]
  Call abc([COLOR=#ff0000]wkb.Worksheets(wkb.VBProject.VBComponents([B]"Sheet" & 1[/B]).Properties("Name").Value)[/COLOR])
End Sub

Xin lỗi vì sơ suất khi thử nghiệm trên file mới mà không để ý SheetName y chang CodeName (nên có nhầm lẫn)

 

[ndu96081631]

Anh ndu có thể sửa trực tiếp lên file của bài 312 cho mọi người học hỏi nha, cảm ơn anh ndu nhiều

Ủa! Thì các bạn cứ mở file ở bài 312 lên, tìm đến Module3 rồi tự sửa cũng được vậy

 

[Hoàng Trọng Nghĩa]

Anh ndu có thể sửa trực tiếp lên file của bài 312 cho mọi người học hỏi nha, cảm ơn anh ndu nhiều

Thử với cái này xem:

Function SheetName(ByVal Wb As Workbook, ByVal CodeName As String) As String
    SheetName = Wb.VBProject.VBComponents(CodeName).Properties("Name").Value
End Function


Sub TestIt()
    Dim St As String
    Dim Wb As Workbook
    Dim Ws As Worksheet
    
    Set Wb = ActiveWorkbook


    St = "sheet1"


    MsgBox SheetName(Wb, St)
    
    Set Ws = Wb.Sheets(SheetName(Wb, St))
End Sub

 

[ndu96081631]

em thay vào nó vẫn bị lỗi anh
View attachment 146682
http://www.mediafire.com/download/0ylyy3e7stg163g/NXT-2014-HL9-6.rar

Như đã nói ở đây:
http://www.giaiphapexcel.com/forum/...n-code-vào-một-trang-tính&p=671850#post671850

Liên quan đến việc truy cập vào môi trường VBA ta phải check mục "Trust access to the VBA project object model" trong Excel Options (cái này tưởng bạn đã biết rồi chứ)

 

[khuongvietphong]

Code lọc các giá trị khác nhau

Xin chào tất cả mọi thành viên GPE. Nhờ mọi người xem giúp em đoạn Code sau tại sao chạy không ra đúng kết quả vậy. Đề bài là lọc

ra những người có tên ở cột A nhưng không có tên ở cột B, kết quả sẽ được hiển thị tại cột C. Em xin chân thành cảm ơn !

 

[doveandrose]

trong code bạn viết bị thiếu 1 dòng

cou = 0

bạn tìm chỗ nhét nó đi

 

[viehoai]

Xin chào tất cả mọi thành viên GPE. Nhờ mọi người xem giúp em đoạn Code sau tại sao chạy không ra đúng kết quả vậy. Đề bài là lọc

ra những người có tên ở cột A nhưng không có tên ở cột B, kết quả sẽ được hiển thị tại cột C. Em xin chân thành cảm ơn !

Thêm câu lệnh cou = 0 dưới hàng For..next đầu tiên (For i = 2 To 13) thử xem sao nhé

 

[khuongvietphong]

trong code bạn viết bị thiếu 1 dòng

cou = 0

bạn tìm chỗ nhét nó đi

Ok. Được rồi anh nhé. Cho câu lệnh đó vào giữa For i và For j.

P/s : ÔI cái đầu NGU quáaaaaaa!!!!!!!!

 

[viehoai]

Ok. Được rồi anh nhé. Cho câu lệnh đó vào giữa For i và For j. Nhưng mà cái này em tưởng nếu mình không gán giá trị ban đầu cho nó là

bao nhiêu thì nó tự lấy giá trị bằng 0. Anh doveandrove giải thích cho em với được không.

Khi i=1 thì cou=0+1=1
Vậy khi i=2 thì theo bạn i =? luôn >0 là chắc chắn nên kết quả của bạn có 1 giá trị duy nhất

 

[khuongvietphong]

Khi i=1 thì cou=0+1=1
Vậy khi i=2 thì theo bạn i =? luôn >0 là chắc chắn nên kết quả của bạn có 1 giá trị duy nhất

Đúng rồi ! Cái này em đúng là bị NGU quá mà Khi mình Next i đi thì biến cou sẽ lấy giá trị cũ của nó từ vòng lặp trước làm giá trị ban đầu nên biến cou đâu còn bằng 0 nữa. Cảm ơn anh nhiều ạ....

 

[ndu96081631]

vì chưa bao giờ làm việc trên file text nên chưa hiểu rõ cách làm việc với nó như thế nào? mong các thành viên giúp đỡ, vấn đề như sau, tôi có rất nhiều file text, bây giờ muốn tổng hợp tất cả các file text đó vào 1 file excel, với mỗi sheet tương ứng là 1 file text, tôi có đính kèm file mẫu, xin được sự giúp đỡ của các bạn, xin chân thành cảm ơn
http://www.mediafire.com/download/qt0bk9ab38xw0jd/CHUYEN_FILE_TEXT_VAO_EXCEL.rar

Lấy dữ liệu từ file text thì được rồi nhưng sao phần tô màu linh tinh vậy? 3 sheet mà tô màu chẳng giống nhau tí nào

 

[ndu96081631]

Không cần tô màu đâu anh

Cho hết đống code này vào 1 Module nhé:

Function SheetExists(ByVal SheetName As String) As Boolean
  On Error Resume Next
  SheetExists = Not Sheets(SheetName) Is Nothing
End Function
Private Sub ImportTextFile(ByVal FilePath As String, ByVal Target As Range)
  With Target.Parent.QueryTables.Add("TEXT;" & FilePath, Target)
    .TextFileTabDelimiter = True
    .Refresh False
  End With
End Sub
Sub Main()
  Dim vFiles, fileItem, wks As Worksheet
  Dim SheetName As String, FilePath As String
  vFiles = Application.GetOpenFilename("Text Files, *.txt", , , , True)
  If IsArray(vFiles) Then
    For Each fileItem In vFiles
      FilePath = CStr(fileItem)
      SheetName = Mid(FilePath, InStrRev(FilePath, "\") + 1)
      SheetName = Left(SheetName, Len(SheetName) - 4)
      If Not SheetExists(SheetName) Then Worksheets.Add(After:=Sheets(Sheets.Count)).Name = SheetName
      Set wks = Worksheets(SheetName)
      wks.UsedRange.Clear
      ImportTextFile FilePath, wks.Range("A1")
    Next
  End If
End Sub

Xong, chay sub Main và xem kết quả
Phần format (tô màu, kẻ khung...) bạn có thể làm bằng tay hoặc bằng code tùy ý
---------------------
Lưu ý: Khi chạy code từ lần thứ 2 trở đi thì nó sẽ xóa dữ liệu cũ, đè lên bằng dữ liệu mới

 

[keke355992]

E chào các AC trong diễn đàn. Nhờ các AC xem giúp em đoạn code không cho nhấp chuột phải tại 1 Picture, e thử mà k thấy nó hoạt động ạ. E xin cảm ơn !

 

[Hoàng Trọng Nghĩa]

E chào các AC trong diễn đàn. Nhờ các AC xem giúp em đoạn code không cho nhấp chuột phải tại 1 Picture, e thử mà k thấy nó hoạt động ạ. E xin cảm ơn !

Protect Sheet là xong chứ gì, đừng có chọn Edit Object là được.

 

[ndu96081631]

E chào các AC trong diễn đàn. Nhờ các AC xem giúp em đoạn code không cho nhấp chuột phải tại 1 Picture, e thử mà k thấy nó hoạt động ạ. E xin cảm ơn !

Bạn đang dùng code:

Sub Worksheet_BeforeRightClick([COLOR=#ff0000]ByVal Target As Range[/COLOR], Cancel As Boolean) 
''......................
End Sub

Chú ý chỗ màu đỏ: Đối số Target thuộc Range. Vậy nên code này chỉ có tác dụng trên Range và đương nhiên chẳng có tác dụng gì với các đối tượng Shape, Picture...

 

[keke355992]

Bạn đang dùng code:

Sub Worksheet_BeforeRightClick([COLOR=#ff0000]ByVal Target As Range[/COLOR], Cancel As Boolean) 
''......................
End Sub

Chú ý chỗ màu đỏ: Đối số Target thuộc Range. Vậy nên code này chỉ có tác dụng trên Range và đương nhiên chẳng có tác dụng gì với các đối tượng Shape, Picture...

Vâng e sẽ nghiên cứu thêm về các đối số này, chúc thầy 1 ngày mới tốt lành

 

[doveandrose]

có nên trả lời cho anh này không ta ? hi hi
cộng dồn số lượng được mà không cộng dồn số lần được là sao ta
dArr(.Item(Tmp), 7) = dArr(.Item(Tmp), 7) + 1

 

[doveandrose]

Bác giúp phát đi. (mới bước vào con đường Dic mà, vì thấy nó thật hay, và nhiều cái tiện, nhưng chưa hiểu được các thuộc tính của nó lắm).
Đọc Dic chỉ thấy mỗi cái Dic.Count nên nó cộng cả cục. Hông biết làm sao cộng đồn từng Item ...hichic

nhìn cho kỹ đi nha . banh con mắt lên mà nhìn #335 đi

 

[doveandrose]

Ôi, chơi xấu nha.......Không bôi đen thì thôi........không thấy!!!

Hic. Mỗi Item khi cộng vẫn còn thiếu 1 đơn vị, chả nhẻ phải là +2

làm hết từ A đến zic sợ bạn buồn . chỉ + 1 thôi nha bạn . thế số lượng bạn cộng dồn làm sao ?

 

[doveandrose]

Không hiểu mới nhờ trợ giúp mà, buồn gì mà buồn bạn ơi. Cộng dồn rồi nhưng thiếu 1 so với countif, hông hiểu luôn!

thôi mình nói luôn vậy
trong khối
if not dic.exists
dArr(k, 7) =1
end if

 

[doveandrose]

Ok. đã được rồi. Cảm ơn, cảm ơn!
Nhưng vẫn chưa hiểu vụ cộng dồn này lắm, Bác có thể giải thích rõ ràng cách chạy code của Dic ở đoạn vừa giúp mình không?

thì mỗi item của Dic ở đây lưu lại số index của item đó trong cái mảng dArr
chẳng hạn gọi dArr(Dic("A"), c + 1) cũng chính là gọi dArr(1,c+1) thôi mà

 

[khuongvietphong]

Chào mọi người, mọi người giúp em thêm câu lệnh nào đó trong File này để sau khi nhấn tô , sẽ không có cái đường viền chạy quanh cell nữa

Ví dụ khi em chon nhạc - Hiếu rồi ấn tô đường viền chạy quanh ô F23 ko xuất hiện nữa. Em xin cảm ơn

 

[khuongvietphong]

Chào mọi người, mọi người giúp em thêm câu lệnh nào đó trong File này để sau khi nhấn tô , sẽ không có cái đường viền chạy quanh cell nữa

Ví dụ khi em chon nhạc - Hiếu rồi ấn tô đường viền chạy quanh ô F23 ko xuất hiện nữa. Nếu có thể xin giải thích giúp em đoạn này trong code với ạ :

With Range("C4:K32").Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With

Em xin cảm ơn

 

[leonguyenz]

Chào mọi người, mọi người giúp em thêm câu lệnh nào đó trong File này để sau khi nhấn tô , sẽ không có cái đường viền chạy quanh cell nữa

Câu lệnh này:

Application.CutCopyMode = False

Mấy dòng trong câu hỏi trên là không tô màu (Fill).

 

[khuongvietphong]

Câu lệnh này:

Application.CutCopyMode = False

Mấy dòng trong câu hỏi trên là không tô màu (Fill).

Cảm ơn anh. Cho em hỏi bây giờ em muốn cứ mỗi làn chọn một 1 cell bất kỳ (từ N3:N33 ) tức là chỉ cần kích chuột 1 lần vào cell đó

là màu nó tự tô vào các ô tương ứng trong bảng mà không cần bấm vào nút tô nữa thì phải làm thế nào ạ

 

[ndu96081631]

Cảm ơn anh. Cho em hỏi bây giờ em muốn cứ mỗi làn chọn một 1 cell bất kỳ (từ N3:N33 ) tức là chỉ cần kích chuột 1 lần vào cell đó

là màu nó tự tô vào các ô tương ứng trong bảng mà không cần bấm vào nút tô nữa thì phải làm thế nào ạ

Cho code vào sự kiện Worksheet_SelectionChange. Tuy nhiên bạn dùng Copy rồi Paste Specials là rất dở
Xem bài 25:
http://www.giaiphapexcel.com/forum/...eo-điều-kiện-bằng-hàm-vba&p=674771#post674771
Hoặc sửa code của bạn thành:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  Dim rngSource As Range, rngColor As Range, cel As Range
  If Not Intersect(Range("N2:N33"), Target) Is Nothing Then
    If Target.Count = 1 Then
      Set rngSource = Range("C4:K32")
      rngSource.Interior.Color = xlNone
      For Each cel In rngSource
        If cel.Value <> Empty Then
          If UCase(cel.Value) = UCase(Target.Value) Then
            cel.Interior.Color = Target.Interior.Color
          End If
        End If
      Next
    End If
  End If
End Sub

Đương nhiên code trên ta cho vào Sheet1 nhé

 

[khuongvietphong]

Cho code vào sự kiện Worksheet_SelectionChange. Tuy nhiên bạn dùng Copy rồi Paste Specials là rất dở
Xem bài 25:
http://www.giaiphapexcel.com/forum/...eo-điều-kiện-bằng-hàm-vba&p=674771#post674771

Cảm ơn chú Ndu ạ. Bài tập này đúng là ở topic trên con thấy hay hay nên lấy về làm thử. Tuy nhiên do mới tiếp xúc với VBA

nên là bài này con chỉ viết với những vốn kiến thức của mình mới học được như dùng For - Next và 1 số câu lệnh đơn giản như Copy _

Paste thôi nên không thể nào mà nói là đã hoàn chỉnh được. Xin chú nói thêm tại sao lại " rất dở " hả chú. Con có thấy điều gì bất thường đâu ạ. Hi hi
Và khi nào ta viết Code cần đưa vào 1 sheet cụ thể, khi nào thì cần đưa vào 1 module ạ. Tại sao trong trường hợp này đưa code vào module thì

lại không được vậy chú .

 

[leonguyenz]

Cảm ơn chú Ndu ạ. Bài tập này đúng là ở topic trên con thấy hay hay nên lấy về làm thử. Tuy nhiên do mới tiếp xúc với VBA

nên là bài này con chỉ viết với những vốn kiến thức của mình mới học được như dùng For - Next và 1 số câu lệnh đơn giản như Copy _

Paste thôi nên không thể nào mà nói là đã hoàn chỉnh được. Xin chú nói thêm tại sao lại " rất dở " hả chú. Con có thấy điều gì bất thường đâu ạ. Hi hi
Và khi nào ta viết Code cần đưa vào 1 sheet cụ thể, khi nào thì cần đưa vào 1 module ạ. Tại sao trong trường hợp này đưa code vào module thì

lại không được vậy chú .

Theo tôi hiểu, có thể bạn làm đúng yêu cầu bài toán, nhưng nếu chỉ cần tô màu, thì nên dùng phương thức Interior, chỉ lấy màu nền, còn lệnh Copy và PasteSpecial Format sẽ lấy nguyên định dạng của ô Copy, mà đã là định dạng thì nhiều vấn đề phức tạp trong đó (Font, Fill, Border, CF, Style, ...)
Còn code đưa vào sheet hay module thì tùy từng code, code sự kiện trên sheet thì đưa và sheet.

 

[keke355992]

E chào các AC, e có đoạn code sau, nhờ các AC giải thích giúp e dòng 6 ; 7 và 9 ạ. E cảm ơn nhiều !

1.Private Sub Worksheet_Change(ByVal Target As Range)
2. Dim fRng As Range, Clls As Range
3. On Error Resume Next
4. If Target.Row >= 5 And Target.Column = 1 Then
5. For Each Clls In Target
6. If Clls.Value = "" Then Clls.Offset(, -1).Resize(, 1) = "" And Clls.Offset(, 1).Resize(, 1) = ""
7. Set fRng = S1.Range(S1.[A1], S1.[A1000].End(3)).Resize(, 1).Find(Clls.Value, , xlValues, xlWhole)
8. If Not fRng Is Nothing Then
9. Clls.Offset(, -1).Resize(, 1) = fRng.Offset(, 1).Resize(, 1).Value
10. Clls.Offset(, 1).Resize(, 1) = fRng.Offset(, 2).Resize(, 1).Value
11. End If
12. Next
13. End If
End Sub

 

[ndu96081631]

E chào các AC, e có đoạn code sau, nhờ các AC giải thích giúp e dòng 6 ; 7 và 9 ạ. E cảm ơn nhiều !

1.Private Sub Worksheet_Change(ByVal Target As Range)
2. Dim fRng As Range, Clls As Range
3. On Error Resume Next
4. If Target.Row >= 5 And Target.Column = 1 Then
5. For Each Clls In Target
6. If Clls.Value = "" Then Clls.Offset(, -1).Resize(, 1) = "" And Clls.Offset(, 1).Resize(, 1) = ""
7. Set fRng = S1.Range(S1.[A1], S1.[A1000].End(3)).Resize(, 1).Find(Clls.Value, , xlValues, xlWhole)
8. If Not fRng Is Nothing Then
9. Clls.Offset(, -1).Resize(, 1) = fRng.Offset(, 1).Resize(, 1).Value
10. Clls.Offset(, 1).Resize(, 1) = fRng.Offset(, 2).Resize(, 1).Value
11. End If
12. Next
13. End If
End Sub

Không cần giải thích đâu bởi code này.. trật lất và sẽ không bao giờ chạy đúng (dù không báo lỗi vì có On Error Resume Next)

 

[leonguyenz]

Không cần giải thích đâu bởi code này.. trật lất và sẽ không bao giờ chạy đúng (dù không báo lỗi vì có On Error Resume Next)

Phiên bản 2025 sẽ có thêm cột âm (-) đứng trước cột A, khi đó code này có ứng dụng được không thầy?

 

[keke355992]

Không cần giải thích đâu bởi code này.. trật lất và sẽ không bao giờ chạy đúng (dù không báo lỗi vì có On Error Resume Next)

Dạ đây thầy ơi. E thấy no hoạt động mà. E chỉ chưa hiểu đoạn code tại dòng 6;7;9 nên mới nhờ các AC giúp ạ

 

[doveandrose]

Nó hoạt động kiểu gì vậy bạn???

tôi đang cố gắng để giữ nguyên code ở trên mà làm cho code chạy được mà vẫn chưa thành công nè . khó quá

 

[ndu96081631]

Dạ đây thầy ơi. E thấy no hoạt động mà. E chỉ chưa hiểu đoạn code tại dòng 6;7;9 nên mới nhờ các AC giúp ạ

Bạn bỏ dòng On Error Resume Next rồi test lại xem có hoạt động không?
Tôi cho rằng code trên phải sửa thế này mới đúng:

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim fRng As Range, Clls As Range
  'On Error Resume Next
  If Target.Row [COLOR=#ff0000]>[/COLOR] 5 And Target.Column = [COLOR=#ff0000]3[/COLOR] Then
    For Each Clls In Target
      [COLOR=#ff0000]If Clls.Value = "" Then
        Clls.Offset(, -1).Resize(, 1) = ""
        Clls.Offset(, 1).Resize(, 1) = ""
      End If[/COLOR]
      Set fRng = S1.Range(S1.[A1], S1.[A1000].End(3)).Find(Clls.Value, , xlValues, xlWhole)
      If Not fRng Is Nothing Then
        Clls.Offset(, -1) = fRng.Offset(, 1).Resize(, 1).Value
        Clls.Offset(, 1) = fRng.Offset(, 2).Resize(, 1).Value
      End If
    Next
  End If
End Sub

Màu đỏ là những chỗ sửa lại

 

[huuthang_bd]

Chắc bạn táy máy sửa cái gì rồi. Nếu cấu trúc dữ liệu là như vậy thì code có lẽ phải như vầy:

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim fRng As Range, Clls As Range
  On Error Resume Next
 'If Target.Row >= 5 And Target.Column = [B][COLOR=#ff0000]1[/COLOR][/B] Then
  If Target.Row >= 5 And Target.Column = [B][COLOR=#0000ff]3[/COLOR][/B] Then
    For Each Clls In Target
     'If Clls.Value = "" Then Clls.Offset(, -1).Resize(, 1) = "" [B][COLOR=#ff0000]And[/COLOR] [/B]Clls.Offset(, 1).Resize(, 1) = ""
      If Clls.Value = "" Then Clls.Offset(, -1).Resize(, 1) = ""[B][COLOR=#0000cd]:[/COLOR][/B] Clls.Offset(, 1).Resize(, 1) = ""
      Set fRng = S1.Range(S1.[A1], S1.[A1000].End(3)).Resize(, 1).Find(Clls.Value, , xlValues, xlWhole)
      If Not fRng Is Nothing Then
        Clls.Offset(, -1).Resize(, 1) = fRng.Offset(, 1).Resize(, 1).Value
        Clls.Offset(, 1).Resize(, 1) = fRng.Offset(, 2).Resize(, 1).Value
      End If
    Next
  End If
End Sub

 

[keke355992]

Dạ đây k phải file của e, e kiếm trên mạng để học hỏi thui ạ. E hiểu cấu trúc file này rùi. Cảm ơn các thầy và ac...

P/s: Khi e muốn xoá 1 Cell. e hay dùng cách này:
i.value = "" Then
i.Offset(, 1).Select
Selection.ClearContents
i.Offset(, 2).Select
Selection.ClearContents

Vậy cách này với cách dùng Resize như ở trên nó khác nhau nhiều ko vậy ạ

 

[ndu96081631]

Dạ đây k phải file của e, e kiếm trên mạng để học hỏi thui ạ. E hiểu cấu trúc file này rùi. Cảm ơn các thầy và ac...

P/s: Khi e muốn xoá 1 Cell. e hay dùng cách này:
i.value = "" Then
i.Offset(, 1).Select
Selection.ClearContents
i.Offset(, 2).Select
Selection.ClearContents

Vậy cách này với cách dùng Resize như ở trên nó khác nhau nhiều ko vậy ạ

Theo code trong file của bạn thì Resize là thừa
Còn code bài này thì Select và Selection là thừa, đồng thời nó sẽ khiến màn hình giật giật. Chỉ cần vầy

If i.value = "" Then
i.Offset(, 1).ClearContents
i.Offset(, 2).ClearContents

Hoặc:

If i.value = "" Then
i.Offset(, 1).Resize(,2).ClearContents

 

[ndu96081631]

Còn bài nữa ở đâu rồi ta?

 

[khuongvietphong]

Nhờ mọi người xem giúp em File này với, tại sao khi em gõ A,B, .. vào ô B4 bên Sheet CT rồi ấn Enter tại sao không hiện lên kết quả tại cột C và D ạ.

Em xin cảm ơn !

 

[leonguyenz]

Nhờ mọi người xem giúp em File này với, tại sao khi em gõ A,B, .. vào ô B4 bên Sheet CT rồi ấn Enter tại sao không hiện lên kết quả tại cột C và D ạ.

Em xin cảm ơn !

Bạn dùng sự kiện Worksheet_SelectionChange, thì gõ A, B xong rồi nhấp vào ô chứa A, B nó mới chạy code, bạn muốn gõ Enter nó chạy code thì đổi sang sự kiện Worksheet_Change và lồng vòng lặp vào trong sự kiện này.

 

[khuongvietphong]

Hãy xem lại bạn đang with cái gì. (selection).......Sao enter nó nhảy được.....

Em nghĩ selection là cell B4 bởi đầu tiên mình phải chọn cell B4 rồi mới gõ A, B,.. vào đó mà

 

[khuongvietphong]

Bạn dùng sự kiện Worksheet_SelectionChange, thì gõ A, B xong rồi nhấp vào ô chứa A, B nó mới chạy code, bạn muốn gõ Enter nó chạy code thì đổi sang sự kiện Worksheet_Change và lồng vòng lặp vào trong sự kiện này.

Em đã thử thay Worksheet_SelectionChange thành Worksheet_Change rồi mà không được, anh sửa giúp em với được không

 

[leonguyenz]

Em đã thử thay Worksheet_SelectionChange thành Worksheet_Change rồi mà không được, anh sửa giúp em với được không

Sửa theo cách viết của bạn, chỉ cần 1 code này:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim iR As Integer
If Not Intersect(Range("B4:B30"), Target) Is Nothing Then
    For iR = 3 To 7
        If Target = Sheets("MA").Cells(iR, 2) Then
            With Target
                .Offset(0, 1) = Sheets("MA").Cells(iR, 3).Value
                .Offset(0, 2) = Sheets("MA").Cells(iR, 4).Value
            End With
        End If
    Next iR
End If
End Sub

Góp ý:
- Khai báo biến tường minh
- Thụt đầu dòng các câu lệnh
- Tìm hiểu thêm hàm Ucase ...

 

[khuongvietphong]

Sửa theo cách viết của bạn, chỉ cần 1 code này:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim iR As Integer
If Not Intersect(Range("B4:B30"), Target) Is Nothing Then
    For iR = 3 To 7
        If Target = Sheets("MA").Cells(iR, 2) Then
            With Target
                .Offset(0, 1) = Sheets("MA").Cells(iR, 3).Value
                .Offset(0, 2) = Sheets("MA").Cells(iR, 4).Value
            End With
        End If
    Next iR
End If
End Sub

Góp ý:
- Khai báo biến tường minh
- Thụt đầu dòng các câu lệnh
- Tìm hiểu thêm hàm Ucase ...

Anh xem giúp em với. Em sửa thành sự kiện Worksheet_Change như anh nói ở trên nhưng bố trí code theo kiểu thành 2 phần riêng tại sao lại không được vậy

 

[ndu96081631]

Anh xem giúp em với. Em sửa thành sự kiện Worksheet_Change như anh nói ở trên nhưng bố trí code theo kiểu thành 2 phần riêng tại sao lại không được vậy

Ai làm kỳ cục vậy chứ!
Bỏ sub Thu đi, sửa code sự kiện thành vầy là được:

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim FindRng As Range
  If Not Intersect(Range("B4:B30"), Target) Is Nothing Then
    If Target.Count = 1 Then
      Set FindRng = Sheets("MA").Range("B3:B100").Find(Target.Value, , xlValues, xlWhole, , , False)
      If Not FindRng Is Nothing Then
        Target.Offset(, 1).Resize(, 2).Value = FindRng.Offset(, 1).Resize(, 2).Value
      Else
        Target.Offset(, 1).Resize(, 2).ClearContents
      End If
    End If
  End If
End Sub

 

[leonguyenz]

Anh xem giúp em với. Em sửa thành sự kiện Worksheet_Change như anh nói ở trên nhưng bố trí code theo kiểu thành 2 phần riêng tại sao lại không được vậy

Code "thu" chưa xác định được đối tượng (Target) trong sự kiện Worksheet_Change.
Bạn tham khảo 2 code sau: (sửa theo code của bạn)

Dim Tmp As String
Sub thu()
Dim i As Long, Tmp2 As Range
Set Tmp2 = ActiveSheet.Range(Tmp)
For i = 3 To 7
    If UCase(Tmp2) = UCase(Sheets("MA").Cells(i, 2)) Then
        With Tmp2
            .Offset(0, 1) = Sheets("MA").Cells(i, 3).Value
            .Offset(0, 2) = Sheets("MA").Cells(i, 4).Value
        End With
    End If
Next i
End Sub


Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Range("B4:B30"), Target) Is Nothing Then
    If Target.Count = 1 Then
        If Target > "" Then
            Tmp = Target.Address(0, 0)
            thu
        End If
    End If
End If
End Sub

 

[langtuchungtinh360]

nhờ GPE giải thích giúp em dòng này với

Application.Calculation = xlCalculationAutomatic

ý nghĩa của nó là gì vậy
--------------------------
em hiểu rồi. là bật lại chế độ tính toán tự động

 

[keke355992]

E chào các AC ạ. E có đoạn code nhờ các AC xem giúp ạ. Khi e xoá dữ liệu cột F, nó k trả về "" (rỗng) mà báo lỗi N/A ạ. E cảm ơn nhìu !!!

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, [F5:F2000]) Is Nothing Then
        On Error Resume Next
        If Target.count = 1 Then
            Range("G" & Target.Row).FormulaR1C1 = "=VLOOKUP(RC6,'DSNCC'!R5C3:R100C10,2,0)"
        With Range("G" & Target.Row)
            .value = .value
        End With
        Else: Range("G" & Target.Row) = ""
        End If
     End If
End Sub

 

[keke355992]

#N/A là đúng rồi. vì cái này "=VLOOKUP(RC6,'DSNCC'!R5C3:R100C10,2,0)". Bạn xài hàm này mà không bẩy lỗi khi giá trị mang đi dò không thỏa thì nó trả về N/A là đúng rồi.

Nếu bạn xài excel 2007 trở lên thì lồng hàm IFERRORngoài hàm vlookup: "=IFERROR(VLOOKUP(RC6,'DSNCC'!R5C3:R100C10,2,0),"")"
còn nếu là excel 2003 thì lồng =if(ISERROR( như sau: "=IF(ISERROR(VLOOKUP(RC6,'DSNCC'!R5C3:R100C10,2,0)),"",VLOOKUP(RC6,'DSNCC'!R5C3:R100C10,2,0))"

E cảm ơn Ạ. Nhưng cái Else kia thì sao ạ, nó k hoạt động đc à a

 

[ndu96081631]

Chào các bạn,
Các bạn giúp mình khắc phục lỗi OverFlow ngay dòng có phép chia trong code giúp. Không biết tại sao lại lại OverFlow (nhìn thì thấy con số bé tí tẹo đem chia cho nhau mà lại tràn...)

Option Explicit
Sub Vlookup()
Dim i As Long, Kq(), DL(), Nguon(), Itm As String, Dic As Object
With Sheet2
    DL = Range(.[A6], .[A65000].End(3)).Resize(, 36)
End With
With Sheet1
    .[D2:K10000].ClearContents
    Nguon = .Range("A2", .Range("A65000").End(3))
    ReDim Kq(1 To UBound(Nguon), 1 To 8)
    Set Dic = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(DL)
    Itm = CStr(DL(i, 4))
        If Not Dic.exists(Itm) Then
            Dic.Add Itm, i
        End If
    Next i
    For i = 1 To UBound(Nguon)
    Itm = CStr(Nguon(i, 1))
        If Dic.exists(Itm) Then
            Kq(i, 1) = DL(Dic.Item(Itm), 27)
            Kq(i, 2) = DL(Dic.Item(Itm), 30)
            Kq(i, 3) = DL(Dic.Item(Itm), 31)
            Kq(i, 4) = DL(Dic.Item(Itm), 33)
            Kq(i, 5) = DL(Dic.Item(Itm), 17)
            Kq(i, 6) = DL(Dic.Item(Itm), 18)
            [COLOR=#ff0000][B]Kq(i, 7) = DL(Dic.Item(Itm), 17) / DL(Dic.Item(Itm), 33)[/B][/COLOR] '"=RC[-2]/RC[-3]"
            [COLOR=#ff0000][B]Kq(i, 8) = DL(Dic.Item(Itm), 18) / DL(Dic.Item(Itm), 17)[/B][/COLOR] '"=RC[-2]/RC[-3]"
        End If
    Next i
    .[D2].Resize(i - 1, 8) = Kq
Set Dic = Nothing
End With
End Sub

Trong mọi phép chia, phải phòng trường hợp mẫu số =0
Sửa lại thành:

[COLOR=#ff0000]If DL(Dic.Item(Itm), 33) <> 0 Then [/COLOR]Kq(i, 7) = DL(Dic.Item(Itm), 17) / DL(Dic.Item(Itm), 33) 
[COLOR=#ff0000]If DL(Dic.Item(Itm), 17) <> 0 Then [/COLOR]Kq(i, 8) = DL(Dic.Item(Itm), 18) / DL(Dic.Item(Itm), 17)

 

[doveandrose]

Cảm ơn anh nhiều! Hixxx. Đúng là không lường cái vụ chia cho 0

cái khó trong câu hỏi này không phải là sửa làm sao cho hết lỗi , mà là tại sao lại có tấm bảng "over flow" ?

 

[keke355992]

Không có file. Tôi hok biết ní do gì...!!!

E Đừa file đậy ạ. Anh cho em hỏi 1 chút nữa. E có 3 Sheet: NHAP - NHAP-2 Và NHAP-3. E muốn hỏi
- 2 phương thức viết Code ở Sheẻt NHAP VÀ NHAP-2 thì phương thức nào chạy nhanh hơn
- Sheẻt NHAP-3 là sheet e đưa file mà lúc sáng em có hỏi là vì sao điều kiện Else nó lại không hoạt động

E cảm ơn Anh nhìu !

 

[huuthang_bd]

E Đừa file đậy ạ. Anh cho em hỏi 1 chút nữa. E có 3 Sheet: NHAP - NHAP-2 Và NHAP-3. E muốn hỏi
- 2 phương thức viết Code ở Sheẻt NHAP VÀ NHAP-2 thì phương thức nào chạy nhanh hơn
- Sheẻt NHAP-3 là sheet e đưa file mà lúc sáng em có hỏi là vì sao điều kiện Else nó lại không hoạt động

E cảm ơn Anh nhìu !

Tôi hay người khác trả lời có được không?

 

[keke355992]

Tôi hay người khác trả lời có được không?

Em mới tìm hiểu VBA, nên muốn được học hỏi từ tất cả các thầy cô và AC trên diễn đàn ạ

 

[huuthang_bd]

E Đừa file đậy ạ. Anh cho em hỏi 1 chút nữa. E có 3 Sheet: NHAP - NHAP-2 Và NHAP-3. E muốn hỏi
- 2 phương thức viết Code ở Sheẻt NHAP VÀ NHAP-2 thì phương thức nào chạy nhanh hơn
- Sheẻt NHAP-3 là sheet e đưa file mà lúc sáng em có hỏi là vì sao điều kiện Else nó lại không hoạt động

E cảm ơn Anh nhìu !

Code ở Sheet NHAP VÀ NHAP-2 làm những việc khác nhau nên không so sánh tốc độ được (một cái cho thao tác nhiều cell 1 cái chỉ cho thao tác 1 cell). Mà bạn cũng không nên quan tâm nhiều về tốc độ vì code như vậy có nhanh hay chậm hơn chút xíu bạn không nhận ra đâu.

Về code. Code ở sheet NHAP có thể xảy ra tình huống ngoài ý muốn khi vùng thao tác có cột F nhưng không phải chỉ mỗi 1 cột, khi xử lý vấn đề này cần phải xét đến trường hợp vùng thao tác gồm nhiều Area nữa. Code ở sheet NHAP-2 về cơ bản không xảy ra trường hợp ngoài mong muốn.

Đoạn Else ở sheet NHAP-3 vẫn chạy bình thường nhưng có lẽ không đúng ý đồ của bạn. Bạn thử chọn F5:F7 rồi xóa sẽ thấy G5 bị xóa, đó là do đoạn Else thực hiện.

 

[keke355992]

Code ở Sheet NHAP VÀ NHAP-2 làm những việc khác nhau nên không so sánh tốc độ được (một cái cho thao tác nhiều cell 1 cái chỉ cho thao tác 1 cell). Mà bạn cũng không nên quan tâm nhiều về tốc độ vì code như vậy có nhanh hay chậm hơn chút xíu bạn không nhận ra đâu.

Về code. Code ở sheet NHAP có thể xảy ra tình huống ngoài ý muốn khi vùng thao tác có cột F nhưng không phải chỉ mỗi 1 cột, khi xử lý vấn đề này cần phải xét đến trường hợp vùng thao tác gồm nhiều Area nữa. Code ở sheet NHAP-2 về cơ bản không xảy ra trường hợp ngoài mong muốn.

Đoạn Else ở sheet NHAP-3 vẫn chạy bình thường nhưng có lẽ không đúng ý đồ của bạn. Bạn thử chọn F5:F7 rồi xóa sẽ thấy G5 bị xóa, đó là do đoạn Else thực hiện.

E cảm ơn những kiến thức cơ bản này của Anh. E thấy Code ở NHAP-2 nó gọn nên cứ phang thui. Còn cái vụ Else em cũng k hiểu vì sao nó lại như thế, nên dùng luôn IFERROR để bẫy lỗi. Chúc a cuối tuần vui vẻ

 

[kimdong80]

Nhu cầu của mình là đếm số ô có chứa chữ định dạng theo màu. Mình dùng code này:
Function CountByColor(range_data As Range, criteria As Range) As Long
Dim datax As Range
Dim xcolor As Long
xcolor = criteria.Font.ColorIndex
For Each datax In range_data
If datax.Font.ColorIndex = xcolor Then
CountByColor = CountByColor + 1
End If
Next datax
End Function. Nhưng đếm xong rồi mình xóa dữ liệu của ô đó thì kết quả không thay đổi. Trong VD của file lúc đầu có 6 ô có chữ màu xanh (đếm đúng) nhưng sau đó mình xóa bớt 1-2 ô đi thì kết quả không thay đổi theo. Các bạn giúp mình chỗ này với

 

[Hoàng Trọng Nghĩa]

Nhu cầu của mình là đếm số ô có chứa chữ định dạng theo màu. Mình dùng code này:
Function CountByColor(range_data As Range, criteria As Range) As Long
Dim datax As Range
Dim xcolor As Long
xcolor = criteria.Font.ColorIndex
For Each datax In range_data
If datax.Font.ColorIndex = xcolor Then
CountByColor = CountByColor + 1
End If
Next datax
End Function. Nhưng đếm xong rồi mình xóa dữ liệu của ô đó thì kết quả không thay đổi. Trong VD của file lúc đầu có 6 ô có chữ màu xanh (đếm đúng) nhưng sau đó mình xóa bớt 1-2 ô đi thì kết quả không thay đổi theo. Các bạn giúp mình chỗ này với

Tôi chả thấy hàm của bạn trong file đó, có lẽ bạn lưu file mà không chọn loại Workbook Enable Macro nên mất hết trơn, tôi đâu có biết criteria của màu là gì đâu mà check cho bạn?

 

[huuthang_bd]

Nhu cầu của mình là đếm số ô có chứa chữ định dạng theo màu. Mình dùng code này:
Function CountByColor(range_data As Range, criteria As Range) As Long
Dim datax As Range
Dim xcolor As Long
xcolor = criteria.Font.ColorIndex
For Each datax In range_data
If datax.Font.ColorIndex = xcolor Then
CountByColor = CountByColor + 1
End If
Next datax
End Function. Nhưng đếm xong rồi mình xóa dữ liệu của ô đó thì kết quả không thay đổi. Trong VD của file lúc đầu có 6 ô có chữ màu xanh (đếm đúng) nhưng sau đó mình xóa bớt 1-2 ô đi thì kết quả không thay đổi theo. Các bạn giúp mình chỗ này với

Tôi không có điều kiện test code nhưng tôi đoán khi xóa bạn chỉ xóa giá trị, định dạng màu của các ô đó vẫn còn nguyên nên kết quả không thay đổi. Để khắc phục thì sửa code lại theo hướng chỉ đếm các ô có giá trị.
Sửa
If datax.Font.ColorIndex = xcolor Then
Thành
If datax.Font.ColorIndex = xcolor And datax.Value <> "" Then

 

[Hoàng Trọng Nghĩa]

Tôi không có điều kiện test code nhưng tôi đoán khi xóa bạn chỉ xóa giá trị, định dạng màu của các ô đó vẫn còn nguyên nên kết quả không thay đổi. Để khắc phục thì sửa code lại theo hướng chỉ đếm các ô có giá trị.
Sửa
If datax.Font.ColorIndex = xcolor Then
Thành
If datax.Font.ColorIndex = xcolor And datax.Value <> "" Then

Anh lại nghĩ, chỉ cần thêm cái này vào hàm là OK rồi:

Function xyz ...
Application.Volatile
.....
End Function

 

[kimdong80]

Tôi không có điều kiện test code nhưng tôi đoán khi xóa bạn chỉ xóa giá trị, định dạng màu của các ô đó vẫn còn nguyên nên kết quả không thay đổi. Để khắc phục thì sửa code lại theo hướng chỉ đếm các ô có giá trị.
Sửa
If datax.Font.ColorIndex = xcolor Then
Thành
If datax.Font.ColorIndex = xcolor And datax.Value <> "" Then

CÁM ƠN BẠN RẤT NHIỀU. Mình đã làm được trường hợp delete thì kết quả thay đổi. Nhưng giờ mình tét thêm thì khi mình ĐỔI MÀU CHỮ trong ô từ màu hồng sang màu xanh thì kết quả không tự cập nhật mà mình phải dbclick vô ô công thức rồi enter thì kết quả mới được cập nhật. Bạn làm ơn giúp mình lần nữa nhé

 

[khuongvietphong]

Chào mọi người, em có vấn đề này cần mọi người giúp đỡ : Bảng tính của em có 2 sheet, em đang viết Sub tại sheet1, em muốn kiểm tra bằng hàm IF xem ô D3 của Sheet1 có bằng với ô A4 của sheet2 không thì em viết như sau:
If range("D3")=.... then . Tuy nhiên cái đoạn ... em không biết điền như thế nào cả, mong mọi người giới thiệu cho em 1 số cách để giải quyết vấn đề trên.

Em xin cảm ơn !

 

[Ba Tê]

Chào mọi người, em có vấn đề này cần mọi người giúp đỡ : Bảng tính của em có 2 sheet, em đang viết Sub tại sheet1, em muốn kiểm tra bằng hàm IF xem ô D3 của Sheet1 có bằng với ô A4 của sheet2 không thì em viết như sau:
If range("D3")=.... then . Tuy nhiên cái đoạn ... em không biết điền như thế nào cả, mong mọi người giới thiệu cho em 1 số cách để giải quyết vấn đề trên.

Em xin cảm ơn !

Viết ở sheet nào thì cũng nên viết rõ:
If sheet1.range("D3").value=sheet2.range("A4").value then

 

[keke355992]

Chào mn. E có dữ liệu tại A1 = 5; A2 = 10. Vậy em muốn chọn vùng tương ứng với dữ liệu của 2 Cell trên là A5:A10 bằng Range thì làm như nào vậy ạ ! E xin cảm ơn ạ

 

[Cá ngừ F1]

Chào mn. E có dữ liệu tại A1 = 5; A2 = 10. Vậy em muốn chọn vùng tương ứng với dữ liệu của 2 Cell trên là A5:A10 bằng Range thì làm như nào vậy ạ ! E xin cảm ơn ạ

Bạn thử code sau:

Range("A" & [A1] & ":A" & [A2]).Select

 

[keke355992]

Bạn thử code sau:

Range("A" & [A1] & ":A" & [A2]).Select

Đúng ý em ồi, thank bác nhìu

 

[khuongvietphong]

Viết ở sheet nào thì cũng nên viết rõ:
If sheet1.range("D3").value=sheet2.range("A4").value then

Dạ cảm ơn thầy Ba Tê nhiều !

 

[khuongvietphong]

Viết ở sheet nào thì cũng nên viết rõ:
If sheet1.range("D3").value=sheet2.range("A4").value then

1,2 ở đây em hiểu là thứ tự các sheet vậy nếu
sheet1 đặt tên là a, sheet2 đặt tên là b thì muốn viết theo tên Sheet thì phải viết như thế nào ạ

 

[kimdong80]

CÁM ƠN BẠN RẤT NHIỀU. Mình đã làm được trường hợp delete thì kết quả thay đổi. Nhưng giờ mình tét thêm thì khi mình ĐỔI MÀU CHỮ trong ô từ màu hồng sang màu xanh thì kết quả không tự cập nhật mà mình phải dbclick vô ô công thức rồi enter thì kết quả mới được cập nhật. Bạn làm ơn giúp mình lần nữa nhé

Bạn huuthang_bd ráng giúp mình nhé. Cám ơn bạn nhiều

 

[giangleloi]

1,2 ở đây em hiểu là thứ tự các sheet vậy nếu
sheet1 đặt tên là a, sheet2 đặt tên là b thì muốn viết theo tên Sheet thì phải viết như thế nào ạ

Thì Phong viết là Sheets("a")

 

[keke355992]

Chào mn. E có dữ liệu tại A1 = 5; A2 = 10. Vậy em muốn chọn vùng tương ứng với dữ liệu của 2 Cell trên là A5:A10 bằng Range thì làm như nào vậy ạ ! E xin cảm ơn ạ

Bạn thử code sau:

Range("A" & [A1] & ":A" & [A2]).Select

Cũng bài toán này, e có dữ liệu tại Range (A5:A10) là (1;2;3;4;5). Thì làm thế nào để kết hợp thêm hàm Sum để cộng dữ liệu đó vậy ạ

 

[ndu96081631]

Chào mn. E có dữ liệu tại A1 = 5; A2 = 10. Vậy em muốn chọn vùng tương ứng với dữ liệu của 2 Cell trên là A5:A10 bằng Range thì làm như nào vậy ạ ! E xin cảm ơn ạ



Cũng bài toán này, e có dữ liệu tại Range (A5:A10) là (1;2;3;4;5). Thì làm thế nào để kết hợp thêm hàm Sum để cộng dữ liệu đó vậy ạ

Thử vầy xem: MsgBox [SUM(A1:A5)]

 

[Cá ngừ F1]

Chào mn. E có dữ liệu tại A1 = 5; A2 = 10. Vậy em muốn chọn vùng tương ứng với dữ liệu của 2 Cell trên là A5:A10 bằng Range thì làm như nào vậy ạ ! E xin cảm ơn ạ



Cũng bài toán này, e có dữ liệu tại Range (A5:A10) là (1;2;3;4;5). Thì làm thế nào để kết hợp thêm hàm Sum để cộng dữ liệu đó vậy ạ

Có phải ý bạn là thế này:

Sub TinhTong()
    [B4] = Application.Sum(Range("A" & [A1] & ":A" & [A2]))
End Sub

Ô B4 là ô hiện thị kết quả

 

[keke355992]

Có phải ý bạn là thế này:

Sub TinhTong()
    [B4] = Application.Sum(Range("A" & [A1] & ":A" & [A2]))
End Sub

Ô B4 là ô hiện thị kết quả

Cảm ơn thầy NDU và a Cá Ngừ. E mò cả buổi cách kết hợp 2 cái Range và Sum này mà k ra.... Đúng ý em rùi ạ ^^

 

[Miccpro]

Nhờ các bác sửa dùm code này với ạ

Sub Them_hang_VLDV()
'
' Them_hang_VLDV Macro
'


'
    Rows("20:20").Select
    Selection.Copy
    Rows("21:21").Select
    Selection.Insert Shift:=xlDown
    Application.CutCopyMode = False
    Range("E21:H21").Select
    Selection.ClearContents
End Sub

Em đang tạo nút bấm có chức năng Insert Copied Cells, vấn đề là mỗi lần bấm nút nó lại chèn ở hàng thứ 21, em muốn chèn tại hàng chứa nút bấm thì phải sửa code trên như thế nào ạ, thanks mọi người

 

[VetMini]

hnagChuaNutBam = ActiveSheet.Buttons(Application.Caller).TopLeftCell.Row

 

[Miccpro]

Anh VetMini hướng dẫn cụ thể hơn tý giúp em được không, em chưa hiểu ý anh lắm, cảm ơn anh

 

[Cá ngừ F1]

Sub Them_hang_VLDV()
'
' Them_hang_VLDV Macro
'


'
    Rows("20:20").Select
    Selection.Copy
    Rows("21:21").Select
    Selection.Insert Shift:=xlDown
    Application.CutCopyMode = False
    Range("E21:H21").Select
    Selection.ClearContents
End Sub

Em đang tạo nút bấm có chức năng Insert Copied Cells, vấn đề là mỗi lần bấm nút nó lại chèn ở hàng thứ 21, em muốn chèn tại hàng chứa nút bấm thì phải sửa code trên như thế nào ạ, thanks mọi người

Tôi chưa hiểu ý bạn lắm.
Thử đính kèm file xem sao?
Muốn chèn tại hàng có nút bấm? Có nghĩa là bạn có nhiều nút bấm ở nhiều hàng khác nhau?
[warning1]Lưu ý tên đề tài nhé bạn. Smod vào sửa giúp tiêu đề cho bạn ý. Xin cảm ơn ![/warning1]

 

[Miccpro]

Không ạ, em muốn mỗi lần Insert Copied Cells thi nó coppy và chèn hàng ở trên chữ END anh ạ

 

[viehoai]

Không ạ, em muốn mỗi lần Insert Copied Cells thi nó coppy và chèn hàng ở trên chữ END anh ạ

Trước khi insert thì copy hàng nào để chèn bạn?

 

[Miccpro]

Trước khi insert thì copy hàng nào để chèn bạn?

Thực tế em chỉ muốn tăng thêm 1 hàng trống mà không làm mất đi công thức trong đó nên dùng Insert Copied Cell, em cmuốn nó chèn hàng mới ngay ở chỗ Button ạ

 

[Cá ngừ F1]

Thực tế em chỉ muốn tăng thêm 1 hàng trống mà không làm mất đi công thức trong đó nên dùng Insert Copied Cell, em cmuốn nó chèn hàng mới ngay ở chỗ Button ạ

Trúng thì trúng, không trúng thì trượt:

Sub ChenThemDong()


    Dim X&


    With ActiveWorkbook.ActiveSheet
        
        X = .[B100000].End(3).Row
        
        If Not UCase(.Cells(X, 2).Value) Like "END" Then
            
            Exit Sub
        
        Else
            
            Rows(X - 1).Insert
            .Range("C" & X) = .Range("B" & X)
        
        End If
    End With

 

[viehoai]

Thực tế em chỉ muốn tăng thêm 1 hàng trống mà không làm mất đi công thức trong đó nên dùng Insert Copied Cell, em cmuốn nó chèn hàng mới ngay ở chỗ Button ạ

Trời chỉ cần dòng lệnh: Sheet1.Range("B65500").End(xlUp).EntireRow.Insert
(do có chữ copied tưởng cần copy hàng trước khi chèn chứ)

 

[Miccpro]

Hihi, em đã tìm được cái mình cần ở bài này rồi ạ:
http://www.giaiphapexcel.com/forum/...de-VBA-để-chèn-dòng-động-theo-bảng-tính/page2
Tuy nhiên nhờ các anh chị sửa dùm code cho phù hợp với bảng tính của em cái ạ, em xin cảm ơn

 

[Miccpro]

Bạn nhờ mọi ngừoi giúp code. Trong khi post cái file lên là .xlsx không có code. Ai biết bạn muốn làm gì. Chí ít thì cũng có cái code sẵn có trong đó, tùy nghi mà chỉnh sửa cho đúng với bài của bạn.

Tôi nghĩ bạn post bài kiểu này không ai đủ kiên nhẩn để hiểu được bạn muốn gì mà code giúp bạn!

Ôi, em xin lỗi ạ, vì mới tập tọe nên còn sai xót. Mong anh/chị thông cảm ạ. Em xin post lại file

 

[huuthang_bd]

Ôi, em xin lỗi ạ, vì mới tập tọe nên còn sai xót. Mong anh/chị thông cảm ạ. Em xin post lại file

Treo đầu dê bán thịt chó à? File xlsm nhưng trong ruột có dòng code nào đâu?

 

[Miccpro]

Híc, cảm ơn các bác đã góp ý, rõ ràng em đã kiểm tra trước khi up file lên mà không hiểu sao, thôi em chép code nhờ các bác vậy ạ???
"Public Sub GPE()
Application.Calculation = xlCalculationManual
Dim CT1(), CT2(), NumR As Long, a As Long, b As Long, Chen As Long, I As Long
CT1 = [A11:M12].FormulaR1C1
CT2 = [A65000].End(xlUp).Offset(1, 5).Resize(43, 170).FormulaR1C1
Chen = InputBox("So Dong muon Chen them:", "GPE")
'----------
a = [A65000].End(xlUp).Row + 1: b = a + Chen - 1
Rows(a & ":" & b).Insert Shift:=xlDown
'---------------
For I = a To b
Range("A" & I).Resize(, 13).FormulaR1C1 = CT1
Next I
Range("F" & b + 1).Resize(43, 170).FormulaR1C1 = CT2
Range("A" & a & ":M" & b).Borders.LineStyle = xlHairline
Application.Calculation = xlCalculationAutomatic
End Sub"
Em muốn đổi đoạn code chỗ Border thành "kẻ viền đường thẳng đứng là nét liền, đường ngang là nét ...." ạ!
Thành thật xin lỗi các bác

 

[doveandrose]

Cho mình hỏi là Trong VBA dùng lệnh nào để show all dòng bị ẩn (khi trước đó đã dùng Advanced Filter lọc tại chỗ) nhỉ?
Trả về trạng thái như chưa Advanced Filter (các dòng không bị hide, khoản cách đều nhau như ban đầu.)

Cảm ơn!

dùng lệnh nào để hide thì cũng dùng lệnh đó để unhide . lêu lêu

 

[doveandrose]

Ừ hỉ. có vậy mà cứ nghỉ đi đâu cao siêu không á... cứ nghỉ là sẽ có nút lệnh gì đó như unhide row cơ chứ... làm 1 phát nó show hết ra. Cơ mà phải chơi chiêu Ad ngược lại cái ban đầu thôi...khứa khứa khứa..

nói vậy hình như là đang đi sai đường rồi đó bồ ơi .

 

[doveandrose]

Hi. Tại gõ phím là ngựoc lại. Nhưng thực thì test dc rồi. Vùng crite chừa trống thì nó show ra hết lại. Heheh

vậy là ngon rồi . thích nhé

 

[khuongvietphong]

Nhờ mọi người xem và sửa lỗi trong Code giúp em với ạ. Em trình bày cụ thể trong File rồi đó.( File này là của thầy BaTe)
Và nếu có thể xin giải thích giúp em đoạn này trong Code với ạ:

Tem = Split(Trim(Str), " ")
Target.Offset(, 1).Value = Tem(UBound(Tem))
Target.Value = Trim(Left(Str, Len(Str) - Len(Target.Offset(, 1))))

Hàm Split có chức năng gì ạ.
Em xin cảm ơn

 

[Ba Tê]

Nhờ mọi người xem và sửa lỗi trong Code giúp em với ạ. Em trình bày cụ thể trong File rồi đó.( File này là của thầy BaTe)
Và nếu có thể xin giải thích giúp em đoạn này trong Code với ạ:

Tem = Split(Trim(Str), " ")
Target.Offset(, 1).Value = Tem(UBound(Tem))
Target.Value = Trim(Left(Str, Len(Str) - Len(Target.Offset(, 1))))

Hàm Split có chức năng gì ạ.
Em xin cảm ơn

Code bị lỗi khi target là empty.
Bẫy lỗi cho nó.

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
On Error Resume Next
Dim Tem, Str As String
If Target.Column = 3 And Target.Count = 1 Then
    If Target <> Empty Then
        Str = UCase(Target)
        Tem = Split(Trim(Str), " ")
        Target.Offset(, 1).Value = Tem(UBound(Tem))
        Target.Value = Trim(Left(Str, Len(Str) - Len(Target.Offset(, 1))))
    Else
        Target.Offset(, 1) = Empty
    End If
End If
Application.EnableEvents = True
End Sub

Muốn hiểu Split là gì thì ấn F1.

 

[khuongvietphong]

Code bị lỗi khi target là empty.
Bẫy lỗi cho nó.

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
On Error Resume Next
Dim Tem, Str As String
If Target.Column = 3 And Target.Count = 1 Then
    If Target <> Empty Then
        Str = UCase(Target)
        Tem = Split(Trim(Str), " ")
        Target.Offset(, 1).Value = Tem(UBound(Tem))
        Target.Value = Trim(Left(Str, Len(Str) - Len(Target.Offset(, 1))))
    Else
        Target.Offset(, 1) = Empty
    End If
End If
Application.EnableEvents = True
End Sub

Muốn hiểu Split là gì thì ấn F1.

Em vẫn biết mọi người nói là không hiểu chổ nào thì mình vào F1 để được trợ giúp, vâng và em cũng đã làm thế rồi nhưng đằng này em cảm thấy vẫn chưa hiểu lắm bởi dịch từ ngôn ngữ nước ngoài về tiếng mẹ đẻ không phải lúc nào cũng chính xác. Vì vậy em muốn nhờ mọi người giảng lại 1 chút cho em bằng tiếng Việt ( theo ý hiểu của riêng mình) cho dể hiểu í mà.

Xin cảm ơn thầy Ba Tê

 

[Ba Tê]

Em vẫn biết mọi người nói là không hiểu chổ nào thì mình vào F1 để được trợ giúp, vâng và em cũng đã làm thế rồi nhưng đằng này em cảm thấy vẫn chưa hiểu lắm bởi dịch từ ngôn ngữ nước ngoài về tiếng mẹ đẻ không phải lúc nào cũng chính xác. Vì vậy em muốn nhờ mọi người giảng lại 1 chút cho em bằng tiếng Việt ( theo ý hiểu của riêng mình) cho dể hiểu í mà.

Xin cảm ơn thầy Ba Tê

Tiếng Anh tui cũng "ba hột, ba đồng", xem ví dụ, lần theo nó, làm thử với vài món "đồ" của mình xem kết quả mỗi món đồ đó khác nhau thế nào, "mò mẫm, rờ rẫm, sờ sẫm" riết rồi cũng "ra" thôi mà.
Tui "chuyên" mò kiểu đó, nên dị ứng với mấy bài viết với giọng văn tiếng nước ngoài " hai hột, hai đồng", dân quê tui hay gọi là "cà chớn lửa".
Ví dụ:
Ô A1 nhập "Doi tui co don nen yeu ai cung ba lon"
Viết Sub đại khái như vầy:

Public Sub MoMam()
Dim Arr
Arr = Split([A1], " ")
[C1].Resize(, UBound(Arr) + 1) = Arr
End Sub

 

[Let'GâuGâu]

Tiếng Anh tui cũng "ba hột, ba đồng", xem ví dụ, lần theo nó, làm thử với vài món "đồ" của mình xem kết quả mỗi món đồ đó khác nhau thế nào, "mò mẫm, rờ rẫm, sờ sẫm" riết rồi cũng "ra" thôi mà.
Tui "chuyên" mò kiểu đó, nên dị ứng với mấy bài viết với giọng văn tiếng nước ngoài " hai hột, hai đồng", dân quê tui hay gọi là "cà chớn lửa".

help của office có tiếng việt mà bác, tất nhiên là online trên trang của microsoft

 

[Miccpro]

Public Sub Chen_dong_DMCV()Application.Calculation = xlCalculationManual
Dim CT1(), CT2(), NumR As Long, a As Long, b As Long, Chen As Long, I As Long
CT1 = [A7:X7].FormulaR1C1
CT2 = [A65000].End(xlUp).Offset(1, 5).Resize(43, 24).FormulaR1C1
Chen = InputBox("So Dong muon Chen them:", "GPE")
'----------
a = [A65000].End(xlUp).Row + 1: b = a + Chen - 1
    Rows(a & ":" & b).Insert Shift:=xlDown
'---------------
For I = a To b
    Range("A" & I).Resize(, 24).FormulaR1C1 = CT1
Next I
Range("F" & b + 1).Resize(43, 24).FormulaR1C1 = CT2
Range("A" & a & ":X" & b).Borders.LineStyle = xlContinuous
Application.Calculation = xlCalculationAutomatic
End Sub

Mình dùng code này để chèn hàng, nhưng khi khóa và ẩn công thức trong bảng tính thì bị lỗi Run-time error '1004'. Mọi người giúp mình vừa khóa được công thức vừa dùng được code để chèn hàng không ạ. Cảm ơn cả nhà

 

[huuthang_bd]

Public Sub Chen_dong_DMCV()Application.Calculation = xlCalculationManual
Dim CT1(), CT2(), NumR As Long, a As Long, b As Long, Chen As Long, I As Long
CT1 = [A7:X7].FormulaR1C1
CT2 = [A65000].End(xlUp).Offset(1, 5).Resize(43, 24).FormulaR1C1
Chen = InputBox("So Dong muon Chen them:", "GPE")
'----------
a = [A65000].End(xlUp).Row + 1: b = a + Chen - 1
    Rows(a & ":" & b).Insert Shift:=xlDown
'---------------
For I = a To b
    Range("A" & I).Resize(, 24).FormulaR1C1 = CT1
Next I
Range("F" & b + 1).Resize(43, 24).FormulaR1C1 = CT2
Range("A" & a & ":X" & b).Borders.LineStyle = xlContinuous
Application.Calculation = xlCalculationAutomatic
End Sub

Mình dùng code này để chèn hàng, nhưng khi khóa và ẩn công thức trong bảng tính thì bị lỗi Run-time error '1004'. Mọi người giúp mình vừa khóa được công thức vừa dùng được code để chèn hàng không ạ. Cảm ơn cả nhà

Muốn vậy thì bạn phải có lệnh mở khóa ở đầu thủ tục và khóa lại ở cuối thủ tục

Sub Chen_dong_DMCV()
    ActiveSheet.Protect Password:="Password của bạn"
    ...
    ActiveSheet.Unprotect Password:="Password của bạn"
End Sub

 

[Miccpro]

Cảm ơn bác huuthang_bd nhưng em thử không được.