Những câu hỏi về code, xin giải thích các code, đề nghị các bạn gửi vào đây

[ST-Lu!]

Kể từ hôm nay, tất cả những câu hỏi nhờ giải thích dùm một đoạn code, hay là hỏi những vấn đề linh tinh gì liên quan đến cách viết code, đề nghị các bạn gửi chung vào đây.

Những đề tài mới với tiêu đề: "Nhờ giải thích dùm đoạn code", mà không nói rõ là code gì, code dùng để làm gì, sẽ bị xóa.

BQT
----------------------------------------------------------------------------------------------------------------


Em xin được hỏi 2 đoạn code sau có tương đương nhau ?

Cells(Cells.Rows.Count, 1).End(xlUp).Row có tương đương với [A65000].End(xlup).row

Cám ơn các anh chỉ giáo

 

[Hong.Van]

Cho mình hỏi anh/chị có thể chia sẻ công thức macro tự chạy công thức excel không ạ ví dụ như khi mình tính toán cho ô a1 và a2 công thức ở ô b1 thì công thức sẽ tự động link xuống các ô b2, b3, b4 mà không cần kéo tay. Như ở file đính kèm ạ

Cái này dùng Data/List là được

 

[kyo]

Diễn đàn giải thích giúp e đoạn code sau :
Chk = (InStr("><=", Left(FindStr, 1)) > 0)

Hàm InStr là hàm dò tìm ký tự hay một cụm ký tự có trong chuỗi.
Cú pháp hàm là: InStr([start, ]string1, string2[, compare])
Ở đây, string1 là chuỗi cần dò tìm (của bạn là chuỗi "><="), string2 là ký tự tìm trong chuỗi (của bạn là ký tự đầu tiên của biến FindStr).
Giả sử ký tự đầu tiên của biến FindStr là <, vậy thì Chk của bạn là True vì nó lớn hơn 0 rồi.

 

[thanhlanh]

Nhìn cái này quen quen, giống hàm Filter2DArray của Thầy NDU quá ta?

Biến Chk này có kiểu là Boolean, trả về True hoặc False

Hàm InStr(xxx) như hàm Find/ Search trong công thức Excel, nó tìm ra vị trí ký tự nó tìm thấy.

Với biến FindStr có kiểu String, là một chuỗi mà khi ở ký tự này nếu có 1 trong các ký tự > , < , = ở đầu chuỗi (hàm Left lấy ký tự đầu) thì cụm công thức (InStr("><=", Left(FindStr, 1)) > 0) sẽ trả về giá trị True, còn không tìm thấy sẽ trả về giá trị False.

Minh hoạ thêm cho bạn ấy dể hiểu, thử chạy code này và kết luận

Sub test()
    Dim chk, FindStr
    FindStr = "= 1000000"
    MsgBox InStr("><=", Left(FindStr, 1))
    chk = InStr("><=", Left(FindStr, 1)) > 0
    MsgBox TypeName(chk)
End Sub

 

[newmenber]

Cho em hỏi, cái bẫy lỗi này sao chỉ làm việc được có 1 lần. Cụ thể là trong folder "Luc nhan su" có các file 001-12, 005-12, 006-12, 009-12....(khoảng hơn 300 file nhưng số không liên tục, chẳng hạn không có file 003-12 và 004-12...). em muốn là nếu file không có thì chương trình tự bỏ qua và tăng j lên. Nhưng chỉ được 1 lần, chương trình báo lỗi là không có file 004-12.

Sub locnhansu()
For j = 1 To 500
        n = Format(j, "000")
        Fname = "J:\Luc nhan su\" & n & "-12.xls"
        On Error GoTo Tiep
        Workbooks.Open Fname
        .....
các lệnh
......
    ActiveWorkbook.Close SaveChanges:=False
Tiep:
Next
End sub

 

[dhn46]

Bạn thử đưa dòng

[COLOR=#000000]        On Error GoTo Tiep
[/COLOR]

Lên sau dòng

[/COLOR][COLOR=#000000]Sub locnhansu()
[/COLOR]

 

[Hong.Van]

Thắc mắc AddIns lạ
-------------------------------
Em thấy trong Excel của em có 1 Addin lạ, em kg hiểu công dụng nó làm gì?
Em nhờ thầy cô & anh chị nó sơ lược công dụng của Addin này ? để nếu kg cần thiết thì để em xóa!

Pass code Wildebeest!!
Em cảm ơn!

 

[ndu96081631]

Thắc mắc AddIns lạ
-------------------------------
Em thấy trong Excel của em có 1 Addin lạ, em kg hiểu công dụng nó làm gì?
Em nhờ thầy cô & anh chị nó sơ lược công dụng của Addin này ? để nếu kg cần thiết thì để em xóa!

Pass code Wildebeest!!
Em cảm ơn!

Code này y chang với code của Analysis ToolPak - VBA
Vậy thì xài thằng Analysis ToolPak - VBA là được rồi ---> Cái lạ lạ kia xóa bớt đi

 

[bienda]

Range("Node").EntireRow.Select
Selection.Insert Shift:=xlDown
ActiveCell.Offset(-1, 0).Rows("1:2").EntireRow.Select
Selection.FillDown
ActiveCell.Offset(1, 2).Range("A1:B1").Select
Selection().ClearContents

ActiveCell.Select

Nhờ các bác giải thích các thao tác thực hiện trên bảng Excel đoạn code trên
K biết là đoạn macro trên đã chỉnh sưa chưa
Em làm mãi macro mà không ra code như trên
Cảm ơn rất nhiều

Thôi, cảm ơn các bác nhiều, em tự vọc và hiểu rồi

 

[kstruong2005]

Nhờ các cao thủ giải dùm code VBA này!

Private Sub CommandButton2_Click()
Sheets("Du lieu loc").Range("A4:G10000").Delete ' Xóa dữ liệu vùng "A4:G10000"
Sheets("Du lieu goc").Range("A4:G10000").Copy ' copy dữ liệu vùng "A4:G10000"
Sheets("Du lieu loc").Range("A4").Select ' Sheet dữ liệu lọc vùng "A4" chọn
ActiveSheet.Paste
Range("H3").Select
Dim i, j, n, dau, cuoi, max As Integer ' Đến chỗ này em không hiểu mong mọi người giúp đỡ chú giải dùm em.
n = 4
Do While Cells(n, "A") <> ""
n = n + 1
Loop
n = n - 1
i = 4
dau = 4
Cells(dau, "H") = "*"
'dua cac gia tri max le dong dau
For i = dau To n
If Cells(i, "A") = Cells(i + 1, "A") Then
If Cells(dau, "C") < Cells(i + 1, "C") Then
Cells(dau, "B") = Cells(i + 1, "B")
Cells(dau, "C") = Cells(i + 1, "C")
Cells(dau, "F") = Cells(i + 1, "F")
Cells(dau, "G") = Cells(i + 1, "G")
End If
If Abs(Cells(dau, "D")) < Abs(Cells(i + 1, "D")) Then
Cells(dau, "D") = Cells(i + 1, "D")
End If
If Abs(Cells(dau, "E")) < Abs(Cells(i + 1, "E")) Then
Cells(dau, "E") = Cells(i + 1, "E")
End If
Else
dau = i + 1
Cells(dau, "H") = "*"
End If
Next i

'Xoa cac dong khong chua Pmax
i = 4
Do While Cells(i, "A") <> ""
If Cells(i, "H") <> "*" Then
Rows(i).Delete
Else
i = i + 1
End If
Loop
Range("H:H").ClearContents
i = 4
Do While Cells(i, "A") <> ""
i = i + 1
Loop
i = i - 1
Range(Cells(4, 1), Cells(i, 7)).Select
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
End With
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlHairline
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlHairline
End With
Range("H16").Select
End Sub

 

[ChanhTQ@]

[thongbao]Nhờ các cao thủ giải dùm code VBA này![/thongbao]

(1) Giải là nghĩa làm sao vậy bạn?

     Giải thích, giải nghĩa (nghĩa là dịch từ VBA sang tiếng Việt)?
  
     Giải quyết: Sửa chữa, đi đến kết thúc
 
      . . . . . .

(2) Mà sao bạn không dùng chức năng [PHP ]. . . [/php] để dễ đọc làm vậy?

Bạn làm như người khác rỗi việc lắm vậy đó; . . . Thấy chán là họ bỏ đi chỗ khác vui hơn liền hà!

Thân & chúc cuối tuần zui zẻ!

 

[Quang_Hải]

Private Sub CommandButton2_Click()
Sheets("Du lieu loc").Range("A4:G10000").Delete ' Xóa dữ liệu vùng "A4:G10000"
Sheets("Du lieu goc").Range("A4:G10000").Copy ' copy dữ liệu vùng "A4:G10000"
Sheets("Du lieu loc").Range("A4").Select ' Sheet dữ liệu lọc vùng "A4" chọn
ActiveSheet.Paste
Range("H3").Select
Dim i, j, n, dau, cuoi, max As Integer ' Đến chỗ này em không hiểu mong mọi người giúp đỡ chú giải dùm em.

1. Tìm tài liệu VBA căn bản đọc ngấu nghiến trong 6 tháng
2. Tìm trường lớp học trong 3 tháng sẽ nắm hết căn bản
3. Thôi kệ mấy cái code quỷ quái đó đi. Muốn chạy sao cũng được miễn có kết quả là ok rồi

 

[nghiepdung]

Cho em hỏi đoạn code này là như nào ạ

Public Sub GPE()
Dim Arr(), I As Long, J As Long
Arr = Range([D7], [D65000].End(xlUp)).Resize(, 6).Value
For I = 1 To UBound(Arr, 1)
Arr(I, 3) = Arr(I, 3) + Arr(I, 2)
Arr(I, 5) = Arr(I, 5) + Arr(I, 4)
Arr(I, 6) = Arr(I, 3) - Arr(I, 5)
Arr(I, 2) = 0: Arr(I, 4) = 0
Next I
[D7].Resize(I - 1, 6).Value = Arr
End Sub

 

[thanhlanh]

Cho em hỏi đoạn code này là như nào ạ

Public Sub GPE()
Dim Arr(), I As Long, J As Long
Arr = Range([D7], [D65000].End(xlUp)).Resize(, 6).Value ' = Đưa vùng dữ liệu từ ô D1 đến ô cuối cùng có dữ liệu của cột D, mở rộng ra đủ 6 cột ---> vào mảng Arr

For I = 1 To UBound(Arr, 1) ' Cho biến I chạy từng dòng từ đầu đến cuối (theo chiều thứ nhất) của mảng Arr

Arr(I, 3) = Arr(I, 3) + Arr(I, 2) ' tại mỗi dòng, cộng thêm cột thứ 2 vào cột thứ 3
Arr(I, 5) = Arr(I, 5) + Arr(I, 4) ' tt
Arr(I, 6) = Arr(I, 3) - Arr(I, 5) ' tt

Arr(I, 2) = 0: Arr(I, 4) = 0 ' cho cột thứ 2 và thứ 4 bằng 0
Next I
[D7].Resize(I - 1, 6).Value = Arr ' Đưa mảng vào Cells, ở đây nó được gán vào vị trí cũ (D7)
End Sub

 

[thaonguyenxanh3691]

cho em hỏi code này có vấn đề gì không

em nhập mã code để giải phương trình bậc 2 nhưng nếu em cho thêm dòng tính denta vào bảng thì tính ra kết quả đúng mà xuất sang excel cũng đúng còn bỏ dòng tính denta đi nó tính sai nhưng khi xuất sang excel vẫn cho nghiệm đúng
D ở đây là denta

Option Explicit
Dim a As Double, b As Double, c As Double
Dim X1 As Double, X2 As Double, D As Double, X As Double
Public Sub CmdTinh_Click()
a = UserForm1.Txta.Text
b = UserForm1.Txtb.Text
c = UserForm1.Txtc.Text
D = b ^ 2 - 4 * a * c
Select Case D
Case Is > 0
FrmKetqua.Caption = "Phuong trinh da cho co hai nghiem phan biet:"
a = UserForm1.Txta.Text
b = UserForm1.Txtb.Text
c = UserForm1.Txtc.Text
X1 = -b / (2 * a) - D ^ (1 / 2) / (2 * a)
X2 = -b / (2 * a) + D ^ (1 / 2) / (2 * a)
LalGT1.Caption = "X1="
LalGT2.Caption = "X2="
TxtGT1.Visible = True
TxtGT2.Visible = True
LalGT1.Visible = True
LalGT2.Visible = True
Case Is = 0
FrmKetqua.Caption = "Phuong trinh da cho co nghiem kep:"
a = UserForm1.Txta.Text
b = UserForm1.Txtb.Text
c = UserForm1.Txtc.Text
X = -b / (2 * a)
LalGT1.Caption = "X="
LalGT2.Visible = False
TxtGT2.Visible = False
TxtGT1.Visible = True
LalGT1.Visible = True
Case Else
FrmKetqua.Caption = "Phuong trinh da cho vo nghiem"
LalGT1.Visible = False
LalGT2.Visible = False
TxtGT1.Visible = False
TxtGT2.Visible = False
End Select
UserForm1.TxtGT1.Text = Round(X1, 3)
UserForm1.TxtGT2.Text = Round(X2, 3)
UserForm1.TxtGT1.Text = Round(X, 3)
End Sub
Public Sub CmdExcel_Click()
CmdTinh_Click
Select Case D
Case Is > 0
ThisWorkbook.Worksheets(1).Range("A1:B3").Clear
ThisWorkbook.Worksheets(1).Range("A1").Value = "phuong trinh da cho co hai nghiem phan biet:"
ThisWorkbook.Worksheets(1).Range("A2").Value = "X1="
ThisWorkbook.Worksheets(1).Range("B2").Value = Round(X1, 3)
ThisWorkbook.Worksheets(1).Range("A3").Value = "X2="
ThisWorkbook.Worksheets(1).Range("B3").Value = Round(X2, 3)
Case Is = 0
ThisWorkbook.Worksheets(1).Range("A1:B3").Clear
ThisWorkbook.Worksheets(1).Range("A1").Value = "phuong trinh da cho co nghiem kep:"
ThisWorkbook.Worksheets(1).Range("A2").Value = "X="
ThisWorkbook.Worksheets(1).Range("B2").Value = Round(X, 3)
Case Else
ThisWorkbook.Worksheets(1).Range("A1:B3").Clear
ThisWorkbook.Worksheets(1).Range("A1").Value = "phuong trinh da cho vo nghiem"
End Select
ThisWorkbook.Worksheets(1).Columns("A:B").EntireColumn.AutoFit
End Sub
Public Sub CmdThoat_Click()
UserForm1.Hide
End Sub

 

[kyo]

em nhập mã code để giải phương trình bậc 2 nhưng nếu em cho thêm dòng tính denta vào bảng thì tính ra kết quả đúng mà xuất sang excel cũng đúng còn bỏ dòng tính denta đi nó tính sai nhưng khi xuất sang excel vẫn cho nghiệm đúng
D ở đây là denta

Option Explicit
Dim a As Double, b As Double, c As Double
Dim X1 As Double, X2 As Double, D As Double, X As Double
Public Sub CmdTinh_Click()
a = UserForm1.Txta.Text
b = UserForm1.Txtb.Text
c = UserForm1.Txtc.Text
D = b ^ 2 - 4 * a * c
Select Case D
Case Is > 0
FrmKetqua.Caption = "Phuong trinh da cho co hai nghiem phan biet:"
a = UserForm1.Txta.Text
b = UserForm1.Txtb.Text
c = UserForm1.Txtc.Text
X1 = -b / (2 * a) - D ^ (1 / 2) / (2 * a)
X2 = -b / (2 * a) + D ^ (1 / 2) / (2 * a)
LalGT1.Caption = "X1="
LalGT2.Caption = "X2="
TxtGT1.Visible = True
TxtGT2.Visible = True
LalGT1.Visible = True
LalGT2.Visible = True
Case Is = 0
FrmKetqua.Caption = "Phuong trinh da cho co nghiem kep:"
a = UserForm1.Txta.Text
b = UserForm1.Txtb.Text
c = UserForm1.Txtc.Text
X = -b / (2 * a)
LalGT1.Caption = "X="
LalGT2.Visible = False
TxtGT2.Visible = False
TxtGT1.Visible = True
LalGT1.Visible = True
Case Else
FrmKetqua.Caption = "Phuong trinh da cho vo nghiem"
LalGT1.Visible = False
LalGT2.Visible = False
TxtGT1.Visible = False
TxtGT2.Visible = False
End Select
UserForm1.TxtGT1.Text = Round(X1, 3)
UserForm1.TxtGT2.Text = Round(X2, 3)
UserForm1.TxtGT1.Text = Round(X, 3)
End Sub
Public Sub CmdExcel_Click()
CmdTinh_Click
Select Case D
Case Is > 0
ThisWorkbook.Worksheets(1).Range("A1:B3").Clear
ThisWorkbook.Worksheets(1).Range("A1").Value = "phuong trinh da cho co hai nghiem phan biet:"
ThisWorkbook.Worksheets(1).Range("A2").Value = "X1="
ThisWorkbook.Worksheets(1).Range("B2").Value = Round(X1, 3)
ThisWorkbook.Worksheets(1).Range("A3").Value = "X2="
ThisWorkbook.Worksheets(1).Range("B3").Value = Round(X2, 3)
Case Is = 0
ThisWorkbook.Worksheets(1).Range("A1:B3").Clear
ThisWorkbook.Worksheets(1).Range("A1").Value = "phuong trinh da cho co nghiem kep:"
ThisWorkbook.Worksheets(1).Range("A2").Value = "X="
ThisWorkbook.Worksheets(1).Range("B2").Value = Round(X, 3)
Case Else
ThisWorkbook.Worksheets(1).Range("A1:B3").Clear
ThisWorkbook.Worksheets(1).Range("A1").Value = "phuong trinh da cho vo nghiem"
End Select
ThisWorkbook.Worksheets(1).Columns("A:B").EntireColumn.AutoFit
End Sub
Public Sub CmdThoat_Click()
UserForm1.Hide
End Sub

Đọc mãi mới hiểu bạn muốn gì, hic.

    [B]UserForm1.TxtGT1.Text = Round(D, 3)[/B] 'bị thừa
    UserForm1.TxtGT1.Text = Round(X1, 3) 'đưa cái này vào Case D > 0
    UserForm1.TxtGT2.Text = Round(X2, 3) 'đưa cái này vào Case D > 0
    [B]UserForm1.TxtGT1.Text = Round(X, 3)[/B] 'đưa cái này vào Case D = 0

Đây chính xác là chỗ bạn bị lỗi ở file giai pt2. Khi bạn giải ra hai nghiệm phân biệt, tức là biến X1 và X2 của bạn có số. Tuy vậy, biến X lại = 0. Do đó, khi ra X1 X2 và điền vào 2 textbox xong, biến X = 0 lại được điền vào textbox TxtGT1 dẫn đến X1 của bạn luôn = 0. Còn việc khi xuất ra file Excel kết quả của bạn vẫn đúng là do bạn xuất bằng biến chứ không xuất bằng giá trị của textbox nên những gì thể hiện trên textbox không hề liên quan đến việc xuất ra Excel.

Do đó, bạn có thể sửa lại bằng cách như ghi chú kyo có ghi kèm phía trên.

 

[chicpt4748]

Nhờ Pro giải thích dùm code Xóa các dòng trùng có điều kiện

Xin giải thich hộ mình Code. Chân thành cảm ơn.[GPECODE=vb]Sub DeleteArr()Dim T, i As Long, s As Long, k As Long
Dim Arr(), ArrKQ()
Dim Dic As Object, Xoa As String
T = Timer()
Set Dic = CreateObject("Scripting.Dictionary")
Sheets("Data").Select
Arr = Range([A3], [u65000].End(xlUp)).Value
ReDim ArrKQ(1 To UBound(Arr), 1 To 21)
s = 0
For i = 1 To UBound(Arr)

If Not Dic.exists(Arr(i, 1)) Then
s = s + 1
For k = 1 To 21
ArrKQ(s, k) = Arr(i, k)
Next k
Dic.Add Arr(i, 1), i
End If

Next i
With [A3]
.Resize(i, 21).ClearContents
.Resize(s, 21).Value = ArrKQ
End With
MsgBox Timer() - T


End Sub[/GPECODE]

 

[ndu96081631]

Xin giải thich hộ mình Code. Chân thành cảm ơn.

Thật ra code này chẳng phải xóa dòng gì cả
Nó lọc dữ liệu trong vùng A:U, phần tử nào của cột 1 bị trùng thì chỉ lấy 1 thôi. Sau khi lọc, kết quả được cho vào mảng rồi gán ngược xuống sheet
Để lọc duy nhất (Unique) người ta dùng Dictionary. Bạn có thể tham khảo Dictionary tại đây:
http://www.giaiphapexcel.com/forum/showthread.php?60643-Tổng-quan-về-Scripting-Dictionary

 

[LienDong]

Nhờ rút gọn code Copy
----------------------
Mình có ReCord Macros, macros này mở một file khác và copy, nhờ các bạn rút gọn giùm code này

Sub Macro5()

    Workbooks.Open Filename:="D:\DuAnMoi\Tao_1.xls"
    Sheets("DS_Khac").Select
    Range("L2:W4").Select
    Selection.Copy
    Windows("Tao_2.xls").Activate
    Range("BQ2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Windows("Tao_1.xls").Activate
    Application.CutCopyMode = False
    ActiveWindow.Close
    Range("BQ5").Select
End Sub

Cảm ơn các bạn!

 

[ndu96081631]

Nhờ rút gọn code Copy
----------------------
Mình có ReCord Macros, macros này mở một file khác và copy, nhờ các bạn rút gọn giùm code này

Sub Macro5()

    Workbooks.Open Filename:="D:\DuAnMoi\Tao_1.xls"
    Sheets("DS_Khac").Select
    Range("L2:W4").Select
    Selection.Copy
    Windows("Tao_2.xls").Activate
    Range("BQ2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Windows("Tao_1.xls").Activate
    Application.CutCopyMode = False
    ActiveWindow.Close
    Range("BQ5").Select
End Sub

Cảm ơn các bạn!

Đầu tiên bạn phải cho mọi người biết:
- Windows("Tao_2.xls") là cái gì? Có phải là Workbook đang chứa code không?
- Copy từ Tao_1.xls sang Tao_2.xls, vậy paste vào sheet nào?
-----------
Tôi giả định là Tao_2 là Thisworkbook và việc copy paste là paste vào ActiveSheet của Tao_2 nhé:

  Dim FileName As String, wkb As Workbook
  Set wkb = ThisWorkbook
  FileName = "D:\DuAnMoi\Tao_1.xls"
  With Workbooks.Open(FileName)
    .Sheets("DS_Khac").Range("L2:W4").Copy
    wkb.ActiveSheet.Range("BQ2").PasteSpecial 3
    .Close False
  End With
End Sub

 

[cuong0202]

Private Sub cmdxoa_Click()
If DCount("MANCC", "phieunhapkho", "MANCC='" & MANCC & "'") > 0 Then
MsgBox "Can't not delete because it has incurred"
ElseIf MsgBox("Do you realy delete this item ?", vbYesNo + vbQuestion, "Warning") = vbYes Then
DoCmd.SetWarnings False
DoCmd.RunCommand acCmdDeleteRecord
LNCC.Requery
DoCmd.GoToRecord , , acLast
End If
End Sub

Mình tạo 1 nút xóa,,, nó sẽ tìm ở table "phieunhapkho" nếu table này ko có sử dụng cái mã mà mình muốn xóa ,, nó sẽ cho xóa,,,,
bây giờ nó cái mã đó có thể phát sinh thêm ở table "phieuxuatkho"

Vậy mình phải sữa đoạn code trên lại như thế nào??? nhớ mọi người xem giúp.