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

 

[hungvrvaq]

Em chào các Bác!
Em có đoạn code VBA trong 1 file Excel nhưng em đọc và chạy thử nó thì bị lỗi ngay ở dòng Call Init("...... Em đã thử tìn hiểu nhưng trình độ hạn chế quá nên Em nhờ các cao thủ giải thích cho em một số lệch trong đoạn code dưới đây , em xin cảm ơn trước ạ.
sub

....
Call Init("C:\Qp2data", False)
NumDays = OpenFiles(ALL_DATA_FILES, "C:\Qp2data") 'NumDays is just a return error code here.
NumDays = OpenFiles(MASTER_FILE, "C:\Qp2data") 'NumDays is just a return error code here.
NumDays = LoadSymbol("T", Data(1), 1) 'T is the ticker symbol for AT&T.
EndDateNum = 10000 * CLng(Data(1).yy) + 100 * CLng(Data(1).mm) + CLng(Data(1).dd)
NumDays = LoadSymbol("S", Data(1), 1) 'S is the ticker symbol for Sears.
LastDataDateNum = 10000 * CLng(Data(1).yy) + 100 * CLng(Data(1).mm) + CLng(Data(1).dd)
If EndDateNum > LastDataDateNum Then LastDataDateNum = EndDateNum
LastDataDate = DateSerial(Int(LastDataDateNum / 10000), Int(LastDataDateNum / 100) Mod 100, LastDataDateNum Mod 100)
Set Scores = Application.Workbooks("TA.xls").Worksheets("Comman d Sheet")
.....
end sub


Public Declare Sub Init Lib "qpr2vb" (ByVal DataDir$, Optional ByVal UseCD As Long, Optional ByVal BufferDir$, Optional ByVal MinimizeOpens As Long)
Public Declare Sub Done Lib "qpr2vb" ()
Public Declare Function OpenFiles Lib "qpr2vb" (ByVal DATAFILE As Long, ByVal DataDir$) As Long
Public Declare Function CloseFiles Lib "qpr2vb" (ByVal DATAFILE As Long) As Long
Public Declare Function LoadSymbol Lib "qpr2vb" (ByVal Symbol$, Data As DataRec, ByVal MaxRecords As Long, Optional ByVal UseRAWMode As Long, Optional ByVal IgnoreHolidays As Long) As Long
Public Declare Function LoadFirstSymbol Lib "qpr2vb" (Data As DataRec, ByVal MaxRecords As Long, Optional ByVal UseRAWMode As Long, Optional ByVal IgnoreHolidays As Long) As Long
Public Declare Function LoadNextSymbol Lib "qpr2vb" (Data As DataRec, ByVal MaxRecords As Long, Optional ByVal UseRAWMode As Long, Optional ByVal IgnoreHolidays As Long) As Long
Public Declare Function GetCurSymbol Lib "qpr2vb" () As String
Public Declare Function ReadMaster Lib "qpr2vb" (ByVal Comparison As Long, ByVal WhichIndex As Long, ByVal SearchVal$, ByRef MasterRec As EquityMaster) As Long

 

[toandiennuoc123]

Ghép 2 code với nhau

chào các bạn ! Tôi có 2 đoạn code nhờ các bạn ghép hộ.
Đoạn thứ nhất:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
Dim Tem As Variant
If Not Intersect(Target, [AF4:AO13]) Is Nothing Then
Application.EnableEvents = False
Tem = Target
Target.Offset(29) = Target.Offset(29) + Tem
Target.ClearContents
Application.EnableEvents = True
ElseIf Not Intersect(Target, [AF20:AO29]) Is Nothing Then
Application.EnableEvents = False
Tem = Target
Target.Offset(13, -12) = Target.Offset(13, -12) + Tem
Target.ClearContents
Application.EnableEvents = True
ElseIf Not Intersect(Range("AR20:AR29,AU20:AU29,AX20:AX29,BA19:BA30,BD19:BD30,BG16:BG30,BJ19:BJ22"), Target) Is Nothing Then
Application.EnableEvents = False
Tem = Target
Target.Offset(, 1) = Target.Offset(, 1) + Tem
Target.ClearContents
Application.EnableEvents = True
End If
End Sub

Đoạn thứ 2 :
If Not Intersect(Union([bq18], [BX20:CG29]), Target) Is Nothing Then
thaycongthuc
End If
End Sub

Tôi ghép vào nó không chạy, mong các bạn chỉ giáo. Xin chân thành các ơn.

 

[nqcuóng]

Nhờ các anh chị xem qua đoạn code này và giúp em với:
Private Sub cham()
Const HKEY_CURRENT_USER = &H80000001
Set objReg = GetObject("winmgmts:\root\default:StdregProv")
strKeyPath = "Control Panel\International"
strValueName = "sDecimal"
strValue = "."
objReg.SetStringValue HKEY_CURRENT_USER, strKeyPath, strValueName, strValue
end sub
bi lỗi sau : run-time error '-2147217407 (80041001)': automation error

E xin cảm ơn

 

[nvson]

Mình test code trên không thấy báo lỗi gì cả.

 

[overnight_9]

Kiểm tra lổi code.

hi các anh chị.
nhờ các anh kiểm tra xem đoạn code dưới đây logic chưa? nó vẫn thực hiện xong lại báo lổi dòng cuối:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
 Dim Vung, I, J, kK, Mg, TachDm, TachMau, Tong, K, A, B
    If Not Intersect(Target, Range([K24], [K10000].End(xlUp))) Is Nothing Or Not Intersect(Target, Range([AI24], [AI10000].End(xlUp))) Is Nothing Then
   If ActiveCell.Interior.ColorIndex = 6 Then
    UserForm1.Show
    Else
    Vung = ActiveCell.Offset(, -3).Resize(, 14)
        Tong = Tong + Len(ActiveCell) - Len(Replace(ActiveCell, "+", "")) + 1
        ReDim Mg(1 To Tong, 1 To 5)
                TachDm = Split(ActiveCell, "+")
                TachMau = Split(Vung(1, 1), "/")
                For J = LBound(TachDm) To UBound(TachDm)
                    K = K + 1
                      Mg(K, 1) = TachDm(J): Mg(K, 2) = TachMau(J): Mg(K, 3) = Vung(1, 12): Mg(K, 4) = Vung(1, 11): Mg(K, 5) = IIf(Mg(K, 3) = "M", 1 / Vung(1, 14), Vung(1, 14))
                Next J
    ActiveCell.Interior.ColorIndex = 6
 Dim ws As Worksheet
 Set ws = Workbooks("TH_chitiet.xlsm").Worksheets("TH_chitiet")
    With ws.[B1000].End(xlUp)(2)
        If .Row = 5 Then
            .Offset(, -1) = 1
        Else
            .Offset(, -1) = 1 + Application.WorksheetFunction.Max(ws.Range((ws.[B5]), (ws.[B10000].End(xlUp))).Offset(, -1))
        End If
    End With
    ws.[B1000].End(xlUp)(2).Resize(K, 5) = Mg
    ws.Select
    End If
    End If
    
    Set ws = Nothing
End Sub

lổi ở dòng:

ws.Select

cảm ơn nhiều.

 

[overnight_9]

Mình test code trên không thấy báo lỗi gì cả.

hi anh Son khi em double click xuat hiện thông báo:

Method 'select' of Object'_worksheet' failed. em chon Debug thì báo lổ ở ws.select.

em không hiểu cái này

 

[toandiennuoc123]

Nhờ các bạn giải thích dùm đoạn code này
PHP Code:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, [c2]) Is Nothing Then
Dim HangDen, ConLai, Sh As Object
Dim Arr1(), Arr2(), Arr3(), I, J
Set Sh = ThisWorkbook.Worksheets("Sheet1")
HangDen = Sh.[BX20:CG29].Value
ConLai = Sh.[ci20:cr29].Value

ReDim Arr1(1 To 10, 1 To 10): ReDim Arr2(1 To 10, 1 To 10)
For I = 1 To 10
For J = 1 To 10
If HangDen(I, J) > Target.Value Then
Arr1(I, J) = Target.Value
Else
Arr1(I, J) = HangDen(I, J)
End If
If HangDen(I, J) > Arr1(I, J) Then
Arr2(I, J) = HangDen(I, J) - Arr1(I, J)
End If
Next
Next
Sh.[bm20].Resize(10, 10) = Arr1: Sh.[ci20].Resize(10, 10) = Arr2
End If
Sh.Select: Set Sh = Nothing
End Sub

và đặc biệt Sh.Select nó mô tả cái gì?

​

 

[th_kid2001]

Nhờ gỡ lỗi Rum-time!

Nhờ ACE xem giúp và cách khắc phục lỗi: Run-time error: User input is a keyword
Code được viết trong module cua Acad. Trong bản vẽ có insert Attribute (Có file kèm theo).
Cám ơn tất cả!

Đây là đoạn code:
Sub vecn()
Dim newstyle As AcadTextStyle
Dim textstyle As AcadTextStyle
Set textstyle = ThisDrawing.ActiveTextStyle
On Error Resume Next
ThisDrawing.Linetypes.Load "CENTER2", "acad.lin"
Set newstyle = ThisDrawing.TextStyles.Add("VSimPlex")
newstyle.fontFile = Application.path & "/DVB/VSIMPLEX.SHX"
'Tao lop
Dim la_duongtim As AcadLayer
Dim la_duongdong As AcadLayer
Dim la_duongcaodo As AcadLayer
Dim la_duongngang As AcadLayer
Dim la_tencoc As AcadLayer
Set la_duongtim = ThisDrawing.Layers.Add("Duong tim")
la_duongtim.color = acRed
la_duongtim.Linetype = "center2"
Set la_duongdong = ThisDrawing.Layers.Add("Duong dong")
la_duongdong.color = acCyan
Set la_duongcaodo = ThisDrawing.Layers.Add("Cao do MDTN")
la_duongcaodo.color = acRed
Set la_duongngang = ThisDrawing.Layers.Add("Duong ngang")
la_duongngang.color = acWhite
Set la_tencoc = ThisDrawing.Layers.Add("Ten coc")
la_tencoc.color = acWhite
Dim la_kc As AcadLayer
Dim la_hcoc As AcadLayer
Dim la_mss As AcadLayer
Set la_kc = ThisDrawing.Layers.Add("Khoang cach")
la_kc.color = acYellow
Set la_hcoc = ThisDrawing.Layers.Add("Cao do coc")
la_hcoc.color = acWhite
Set la_mss = ThisDrawing.Layers.Add("MSS")
la_mss.color = acGreen

Dim p_chuan As Variant
Dim ph_chuan As Variant
Dim p_ints As Variant
Dim p_chuan1(0 To 2) As Double
Dim p_ten(0 To 2) As Double
Dim p_coc(0 To 2) As Double
Dim tencoc As String
Dim cdcoc As Double
Dim cd As Double
Dim coc As AcadText
Dim tl, mss, tlve As Double
Dim tl_str, mss_str, tl_ve As String

'Ve_ben_huu:
Dim d_huu As Double
Dim p_huu As Variant
Dim l_huu, ngang_huu, ngang1_huu, ngang2_huu, dong_huu, dong1_huu As AcadLine
Dim sp_huu As Variant
Dim h_huu As String
Dim hhuu As Double
Dim sphuu(0 To 2) As Double
Dim phuu(0 To 2) As Double
Dim pin_huu As Variant
Dim ep_huu(0 To 2) As Double

tl_str = ThisDrawing.Utility.GetString(False, vbCrLf & "Nhap ti le binh do: ")
tl = Val(tl_str)
tl_ve = ThisDrawing.Utility.GetString(False, vbCrLf & "Nhap ti le ve mat CN: ")
tlve = Val(tl_ve)
mss_str = ThisDrawing.Utility.GetString(False, vbCrLf & "Nhap muc so sanh: ")
mss = Val(mss_str)
'veduongchuan:
p_ints = ThisDrawing.Utility.GetPoint(, vbCrLf & "Chon diem chuan: ")

'laytencoc:
Dim pick As AcadSelectionSet
Dim att() As AcadAttributeReference
Dim obj As AcadObject
Dim n As Integer
Dim p As Variant
Dim ph As Variant
Dim m As Integer
Dim ph_in As Variant
bat_dau:
Dim pint(0 To 2) As Double
Dim pinh(0 To 2) As Double
pint(0) = p_ints(0)
pint(1) = p_ints(1) - 135.9 * m

pinh(0) = p_ints(0)
pinh(1) = p_ints(1) - 135.9 * m

p_chuan = pint
ph_chuan = pinh

p_chuan1(0) = p_chuan(0)
p_chuan1(1) = p_chuan(1) + 95

ThisDrawing.Utility.Prompt vbCrLf & ("Chon coc cat ngang: ")
Set pick = ThisDrawing.PickfirstSelectionSet
pick.SelectOnScreen
For Each obj In pick
m = m + 1
att = obj.GetAttributes
For n = LBound(att) To UBound(att)
p = obj.InsertionPoint
ph = obj.InsertionPoint
tencoc = att(0).TextString
cdcoc = att(1).TextString
cd = att(1).TextString
Next n
ph_in = ph
Next obj
'Gan ten coc
Dim l_tim As AcadLine
Set l_tim = ThisDrawing.ModelSpace.AddLine(p_chuan, p_chuan1)
l_tim.layer = "Duong tim"
l_tim.LinetypeScale = 25

p_coc(0) = p_chuan1(0)
p_coc(1) = p_chuan1(1) + 1
Set coc = ThisDrawing.ModelSpace.AddText("%%u" & tencoc, p_coc, 4)
coc.layer = "Ten coc"
coc.Alignment = acAlignmentCenter
coc.TextAlignmentPoint = p_coc
coc.StyleName = "VSimPlex"

'Gan cao do coc
Dim text_coc As AcadText
Dim pin_coc(0 To 2) As Double

pin_coc(0) = p_chuan(0)
pin_coc(1) = p_chuan(1) - 5
Set text_coc = ThisDrawing.ModelSpace.AddText(FormatNumber(cdcoc, 2), pin_coc, 2)
text_coc.layer = "Cao do MDTN"
text_coc.Alignment = acAlignmentMiddleCenter
text_coc.TextAlignmentPoint = pin_coc
text_coc.Rotation = 90 * 3.14159265358979 / 180
text_coc.StyleName = "VSimPlex"

GoTo ve_ta
'Ve_ben_ta:
Dim d_ta As Double
Dim p_ta As Variant
Dim l_ta, ngang_ta, ngang1_ta, ngang2_ta, dong_ta, dong1_ta As AcadLine
Dim sp_ta As Variant
Dim h_ta As String
Dim hta As Double
Dim ep_ta(0 To 2) As Double
Dim sp1_ta(0 To 2) As Double
Dim pta(0 To 2) As Double

ve_ta:
sp1_ta(0) = p_chuan(0)
sp1_ta(1) = p_chuan(1) + ((cdcoc - mss) * 1000 / tlve)
sp_ta = sp1_ta

ep_ta(0) = p_chuan(0)
ep_ta(1) = p_chuan(1)

'Toa do ve duong ngang ta
Dim sp_ngangt As Variant
Dim ep_ngangt(0 To 2) As Double
sp_ngangt = p_chuan

Dim sp1_ngangt As Variant
Dim sp1ngangt(0 To 2) As Double
Dim ep1_ngangt(0 To 2) As Double
sp1ngangt(0) = p_chuan(0)
sp1ngangt(1) = p_chuan(1) - 10
sp1_ngangt = sp1ngangt

Dim sp2_ngangt As Variant
Dim sp2ngangt(0 To 2) As Double
Dim ep2_ngangt(0 To 2) As Double
sp2ngangt(0) = p_chuan(0)
sp2ngangt(1) = p_chuan(1) - 20
sp2_ngangt = sp2ngangt

'Ve duong dong chuan
Dim l_c As AcadLine
Dim sp_c(0 To 2) As Double
Dim ep_c(0 To 2) As Double

sp_c(0) = sp1ngangt(0)
sp_c(1) = sp1ngangt(1)

ep_c(0) = sp2ngangt(0)
ep_c(1) = sp2ngangt(1)
Set l_c = ThisDrawing.ModelSpace.AddLine(sp_c, ep_c)
l_c.layer = "Duong dong"

Dim lua_t As String
lua_t = ThisDrawing.Utility.GetString(False, vbCrLf & "Nhan Enter de ve ben ta: ")
If lua_t <> "" Then
GoTo thoat
Else
GoTo Ve_ben_ta
End If

Ve_ben_ta:
On Error GoTo ve_huu
Do
p_ta = ThisDrawing.Utility.GetPoint(, vbCrLf & "Chon diem CN ben ta tiep theo hoac nhan Enter de ve ben huu: ")
pta(0) = p_ta(0)
pta(1) = p_ta(1)
d_ta = (Sqr(((p(0) - pta(0)) ^ 2) + (p(1) - pta(1)) ^ 2)) * 1000 / tl
h_ta = ThisDrawing.Utility.GetString(False, vbCrLf & "Nhap cao do: ")
hta = Val(h_ta)

ep_ta(0) = ep_ta(0) - d_ta
ep_ta(1) = p_chuan(1) + ((hta - mss) * 1000 / tlve)
Set l_ta = ThisDrawing.ModelSpace.AddLine(sp_ta, ep_ta)
l_ta.layer = "Cao do MDTN"
sp_ta = ep_ta
cdcoc = hta
p = pta
'Ve duong ngang 1

ep_ngangt(0) = ep_ta(0)
ep_ngangt(1) = p_chuan(1)
Set ngang_ta = ThisDrawing.ModelSpace.AddLine(sp_ngangt, ep_ngangt)
ngang_ta.layer = "Duong ngang"
sp_ngangt = ep_ngangt
'Ve duong ngang 2

ep1_ngangt(0) = ep_ta(0)
ep1_ngangt(1) = p_chuan(1) - 10
Set ngang1_ta = ThisDrawing.ModelSpace.AddLine(sp1_ngangt, ep1_ngangt)
ngang1_ta.layer = "Duong ngang"
sp1_ngangt = ep1_ngangt
'Ve duong ngang 3

ep2_ngangt(0) = ep_ta(0)
ep2_ngangt(1) = p_chuan(1) - 20
Set ngang2_ta = ThisDrawing.ModelSpace.AddLine(sp2_ngangt, ep2_ngangt)
ngang2_ta.layer = "Duong ngang"
sp2_ngangt = ep2_ngangt
'Ve duong dong
Dim sp_dongt(0 To 2) As Double
Dim ep_dongt(0 To 2) As Double
sp_dongt(0) = ep_ngangt(0)
sp_dongt(1) = ep_ngangt(1)

ep_dongt(0) = ep_ta(0)
ep_dongt(1) = ep_ta(1)

Set dong_ta = ThisDrawing.ModelSpace.AddLine(sp_dongt, ep_dongt)
dong_ta.layer = "Duong dong"
'Ve duong dong 1
Dim sp1_dongt(0 To 2) As Double
Dim ep1_dongt(0 To 2) As Double
sp1_dongt(0) = ep1_ngangt(0)
sp1_dongt(1) = ep1_ngangt(1)

ep1_dongt(0) = ep2_ngangt(0)
ep1_dongt(1) = ep2_ngangt(1)

Set dong1_ta = ThisDrawing.ModelSpace.AddLine(sp1_dongt, ep1_dongt)
dong1_ta.layer = "Duong dong"
'Gan cao do mat dat
Dim text_md As AcadText
Dim pin_md(0 To 2) As Double
pin_md(0) = ep_ngangt(0)
pin_md(1) = ep_ngangt(1) - 5
Set text_md = ThisDrawing.ModelSpace.AddText(FormatNumber(hta, 2), pin_md, 2)
text_md.layer = "Cao do coc"
text_md.Alignment = acAlignmentMiddleCenter
text_md.TextAlignmentPoint = pin_md
text_md.Rotation = 90 * 3.14159265358979 / 180
text_md.StyleName = "VSimPlex"

'Gan khoang cach
Dim text_kc As AcadText
Dim pin_kc(0 To 2) As Double
pin_kc(0) = ep1_dongt(0) + (d_ta / 2)
pin_kc(1) = ep1_ngangt(1) - 5
Set text_kc = ThisDrawing.ModelSpace.AddText(FormatNumber(d_ta, 2), pin_kc, 2)
text_kc.layer = "Khoang cach"
text_kc.Alignment = acAlignmentCenter
text_kc.TextAlignmentPoint = pin_kc
text_kc.StyleName = "VSimPlex"
Loop

ve_huu:
'Gan mss
Dim text_mss As AcadText
Dim pin_mss(0 To 2) As Double
pin_mss(0) = ep_ngangt(0) - 1.5
pin_mss(1) = ep_ngangt(1) + 1
Set text_mss = ThisDrawing.ModelSpace.AddText(FormatNumber(mss, 2), pin_mss, 2)
text_mss.layer = "MSS"
text_mss.Alignment = acAlignmentRight
text_mss.TextAlignmentPoint = pin_mss
text_mss.StyleName = "VSimPlex"

sp_huu = pinh 'Sp ve duong ngang huu
sphuu(0) = pinh(0)
sphuu(1) = pinh(1) + ((cd - mss) * 1000 / tlve)
p_huu = sphuu 'Sp be duong MDTN

Dim e_h(0 To 2) As Double
e_h(0) = ph_chuan(0)
e_h(1) = ph_chuan(1)

Dim lua_h As String
lua_h = ThisDrawing.Utility.GetString(False, vbCrLf & "Nhan Enter de ve ben huu: ")
If lua_h = "" Then
GoTo Ve_ben_huu
End If

Ve_ben_huu:
'On Error GoTo chuyen
Do
On Error GoTo chuyen
'ThisDrawing.Utility.InitializeUserInput 1
pin_huu = ThisDrawing.Utility.GetPoint(, vbCrLf & "Chon diem CN ben huu tiep theo hoac nhan Enter de ve mat cat tiep: ")
ep_huu(0) = pin_huu(0)
ep_huu(1) = pin_huu(1)

d_huu = (Sqr((ph_in(0) - ep_huu(0)) ^ 2 + (ph_in(1) - ep_huu(1)) ^ 2)) * 1000 / tl
h_huu = ThisDrawing.Utility.GetString(False, vbCrLf & "Nhap cao do: ")
hhuu = Val(h_huu)

'Ve duong MDTN ben huu
e_h(0) = e_h(0) + d_huu
e_h(1) = ph_chuan(1) + ((hhuu - mss) * 1000 / tlve)
Set l_huu = ThisDrawing.ModelSpace.AddLine(p_huu, e_h)
l_huu.layer = "Cao do MDTN"
p_huu = e_h
cd = hhuu
ph_in = ep_huu
Loop
'GoTo Ve_ben_huu
chuyen:
MsgBox "Dang hoan thien"

thoat:
End Sub

 

[concuarangme]

mình có đoạn code

Sub PhanCong()Dim KHRng As Range, KH As Variant, NV As Variant, i As Long, j As Long, NVi As Long, KHs As Long
Set KHRng = ActiveSheet.Range([C65536].End(xlUp), [C2])
KHRng.Offset(, 2).Resize(, 2).ClearContents
KH = KHRng.Resize(, 4).Value
NV = Range([M5], [I65536].End(xlUp)).Value
For i = 1 To UBound(KH, 1)
  KHs = 99999
  For j = 1 To UBound(NV)
    If KH(i, 1) = NV(j, 4) And KH(i, 2) = NV(j, 3) Then
      If NV(j, 5) < KHs Then
        KHs = NV(j, 5)
        NVi = j
      End If
    End If
  Next
  If KHs < 99999 Then
    KH(i, 3) = NV(NVi, 1)
    KH(i, 4) = NV(NVi, 2)
    NV(NVi, 5) = NV(NVi, 5) + 1
  End If
Next
KHRng.Resize(, 4).Value = KH
End Sub

mình ko hiểu đoạn này chạy như thế nào, các bạn hướng dẫn giúp mình nhé.

For i = 1 To UBound(KH, 1)  KHs = 99999
  For j = 1 To UBound(NV)
    If KH(i, 1) = NV(j, 4) And KH(i, 2) = NV(j, 3) Then
      If NV(j, 5) < KHs Then
        KHs = NV(j, 5)
        NVi = j
      End If
    End If
  Next
  If KHs < 99999 Then
    KH(i, 3) = NV(NVi, 1)
    KH(i, 4) = NV(NVi, 2)
    NV(NVi, 5) = NV(NVi, 5) + 1
  End If
Next
KHRng.Resize(, 4).Value = KH

 

[vodoi2x]

mình ko hiểu đoạn này chạy như thế nào, các bạn hướng dẫn giúp mình nhé.

Muốn hiểu thì bạn hiểu FOR và IF là hiểu được đoạn đó rui, bạn viết được vậy thì chắc không khó hiểu đâu

 

[concuarangme]

Muốn hiểu thì bạn hiểu FOR và IF là hiểu được đoạn đó rui, bạn viết được vậy thì chắc không khó hiểu đâu

đoạn code đó ko phải do mình viết, và mình cũng ko rõ nhiều về VBA, mình muốn biết cách chạy của đoạn code đó đề áp dụng vào file mình đang làm, do file mình có những dòng cột khác với đoạn code đó nên chạy ko tốt trong file của mình.

 

[vodoi2x]

đoạn code đó ko phải do mình viết, và mình cũng ko rõ nhiều về VBA, mình muốn biết cách chạy của đoạn code đó đề áp dụng vào file mình đang làm, do file mình có những dòng cột khác với đoạn code đó nên chạy ko tốt trong file của mình.

Thế thì bạn nên up file bạn nên và nhét code trên vào để ng giúp tham khảo,

về code Vùng DL thì ở mấy dòng này, bạn ah

Set KHRng = ActiveSheet.Range([C65536].End(xlUp), [C2])
KHRng.Offset(, 2).Resize(, 2).ClearContents
KH = KHRng.Resize(, 4).Value
NV = Range([M5], [I65536].End(xlUp)).Value

bạn cũng nên đặt rõ lại bài toán, hoặc nếu code trên bạn biết rõ là của ai , thì liên hệ trực tiếp thành viên đó thì họ giúp bạn nhanh hơn

 

[TránhXaRa]

Dưới đây là code của Thầy quanghai1969 trong bài viết:Báo Cáo Sản Xuất của 3 Ca
Xin cám ơn Thầy bài Em gửi nháp lên đúng là rất đúng ý của Em
Nhưng do Em không hiểu hay là chưa có 1 kiên thức gì về vba cả
lên chưa lĩnh hội được code của Thầy!

Option Explicit
Sub loc()
Dim dl(), i, j, d As Object, kq(1 To 10000, 1 To 2), k
Set d = CreateObject("scripting.dictionary")
For i = 4 To 10 Step 3
   dl = Sheet1.Range(Sheet1.Cells(9, i), Sheet1.Cells(65536, i + 1)).Value
   For j = 1 To UBound(dl)
      If dl(j, 2) <> "" Then
         If Not d.exists(dl(j, 1) & dl(j, 2)) Then
            k = k + 1
            d.Add dl(j, 1) & dl(j, 2), ""
            kq(k, 1) = dl(j, 1)
            kq(k, 2) = dl(j, 2)
         End If
      End If
   Next
Next
With Sheet2
   .[a3:b10000].ClearContents
   .[a3].Resize(k, 2) = kq
   .Range(.[a2], .[b65536].End(3)).Sort key1:=.[a2], Header:=1
End With
End Sub

Mong các Thầy trong GPE ai hiểu tường tận code này xin hãy giải thích giúp Em tường tận code trên từ đầu đến cuối để Em hiểu và vận dụng nó với.
Em xin cám ơn!

 

[Quang_Hải]

Dưới đây là code của Thầy quanghai1969 trong bài viết:Báo Cáo Sản Xuất của 3 Ca
Xin cám ơn Thầy bài Em gửi nháp lên đúng là rất đúng ý của Em
Nhưng do Em không hiểu hay là chưa có 1 kiên thức gì về vba cả
lên chưa lĩnh hội được code của Thầy!

Option Explicit
Sub loc()
Dim dl(), i, j, d As Object, kq(1 To 10000, 1 To 2), k
Set d = CreateObject("scripting.dictionary")
For i = 4 To 10 Step 3
   dl = Sheet1.Range(Sheet1.Cells(9, i), Sheet1.Cells(65536, i + 1)).Value
   For j = 1 To UBound(dl)
      If dl(j, 2) <> "" Then
         If Not d.exists(dl(j, 1) & dl(j, 2)) Then
            k = k + 1
            d.Add dl(j, 1) & dl(j, 2), ""
            kq(k, 1) = dl(j, 1)
            kq(k, 2) = dl(j, 2)
         End If
      End If
   Next
Next
With Sheet2
   .[a3:b10000].ClearContents
   .[a3].Resize(k, 2) = kq
   .Range(.[a2], .[b65536].End(3)).Sort key1:=.[a2], Header:=1
End With
End Sub

Mong các Thầy trong GPE ai hiểu tường tận code này xin hãy giải thích giúp Em tường tận code trên từ đầu đến cuối để Em hiểu và vận dụng nó với.
Em xin cám ơn!

Code này mình viết nhưng kêu giải thích thì chịu thua. Mặc dù code chỉ có mấy dòng cơ bản thôi nhưng để hiểu được thì phải mất vài tháng nghiên cứu.
Mình khuyên bạn nên làm quen với những code cơ bản, xử lý trên sheet trước khi chạm vào cái Array trừu tượng này.

Thân

 

[thanhlanh]

Dưới đây là code của Thầy quanghai1969 trong bài viết:Báo Cáo Sản Xuất của 3 Ca
Xin cám ơn Thầy bài Em gửi nháp lên đúng là rất đúng ý của Em
Nhưng do Em không hiểu hay là chưa có 1 kiên thức gì về vba cả
lên chưa lĩnh hội được code của Thầy!


Mong các Thầy trong GPE ai hiểu tường tận code này xin hãy giải thích giúp Em tường tận code trên từ đầu đến cuối để Em hiểu và vận dụng nó với.
Em xin cám ơn!

Option Explicit ' Khi đặt dòng này trước một module thì tất cả các biến dùng trong module đó phải được khai báo
Sub loc() ' Tên thủ tục 
Dim dl(), i, j, d As Object, kq(1 To 10000, 1 To 2), k ' Khai báo các biến
Set d = CreateObject("scripting.dictionary") ' gán d là đối tượng thuộc "scripting.dictionary"
For i = 4 To 10 Step 3 ' cho thằng i chạy từ 4 đến 10 nhưng nhảy cóc 3 bước một
   dl = Sheet1.Range(Sheet1.Cells(9, i), Sheet1.Cells(65536, i + 1)).Value ' gán cho mảng dl một vùng từ ô tại dòng 9 cột i đến ô tại dòng cuối cùng cột thứ i+1
   For j = 1 To UBound(dl) ' cho j chạy từ 1 đến tổng số dòng của mảng dl (không nhảy cóc như i)
      If dl(j, 2) <> "" Then ' Nếu giá trị của phần tử dòng thứ j, cột 2 của mảng dl có dữ liệu thì xét tiếp
         If Not d.exists(dl(j, 1) & dl(j, 2)) Then ' Nếu hai pt (phần tử) của cột thứ nhất và cột thứ 2 của cùng dòng thứ j trong mảng dl nối với nhau mà chưa có trong từ điển d (nôm na là vậy) thì            
            k = k + 1 ‘ mỗi lần thỏa dk ta được thêm một
            d.Add dl(j, 1) & dl(j, 2), ""  ' đưa chuổi ghép dl(j, 1) & dl(j, 2) vào từ điển d để lần sau tránh mặt không cho mi vào nữa (lọc duy nhất)
            kq(k, 1) = dl(j, 1) '  cho phần tử thuộc dòng thứ k cột 1 của mảng kq bằng pt dl(j, 1)
            kq(k, 2) = dl(j, 2) '  cho phần tử thuộc dòng thứ k cột 2 của mảng kq bằng pt dl(j, 2)

         End If
      End If
   Next 
Next
With Sheet2 ‘ làm việc vớ sheet2
   .[a3:b10000].ClearContents ‘ xóa a3:b10000
   .[a3].Resize(k, 2) = kq ‘ lấy ô A3 làm chuẩn, mở rộng cho đủ k dòng và hai cột để dưa mảng kq vào
   .Range(.[a2], .[b65536].End(3)).Sort key1:=.[a2], Header:=1 ‘ sắp xếp dữ liệu theo abc
End With
End Sub

 

[nguyenthuy13388]

Khi save Excel báo lỗi

Các thầy ơi Em có 1file khi save nó báo lỗi như sau Em có dịch bằng google nhưng vẫn không hiểu ah.?)

" PRIVACY WARNING: THIS DOCUMENT CONTAIN MACRO, ACTIVEx CONTROLS, XML EXPANSION PACK INFORMATION, OR WEB COMPONENTS. THESE MAY INCLUDE PERSONAL INFORMATION THAT CAN NOT BE REMOVE BY THE DOCUMENT INSPECTOR".

 

[nguyenthuy13388]

Có Ai giải thích giúp Em ý nghĩa của code dưới đây không ah?
Application.CutCopyMode = False

 

[vanle33]

Có Ai giải thích giúp Em ý nghĩa của code dưới đây không ah?
Application.CutCopyMode = False

Mình đoán mò là loại bỏ chế độ dấu chấm chấm bao quanh vùng dữ liệu Copy
Các cao thủ Code cho biết có phải như vậy ko?

 

[ndu96081631]

Có Ai giải thích giúp Em ý nghĩa của code dưới đây không ah?
Application.CutCopyMode = False

Tính từ dòng code này trở đi, bạn sẽ không thể paste những thứ đã copy từ các cell trên bảng tính được nữa ---> Nó tương đương với việc bạn bấm phím ESC (sau khi bấm Ctrl + C)

 

[nguyenthuy13388]

Vâng. bây giờ thì Em đã hiểu.