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 (2 người xem)

ST-Lu! · 23/10/08

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 · 8/6/12

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 · 3/7/12

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 · 5/7/12

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 · 10/7/12

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

overnight_9 · 10/7/12

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:

PHP:

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:

PHP:

ws.Select

cảm ơn nhiều.

overnight_9 · 10/7/12

nvson đã viết:
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 · 6/8/12

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 · 12/8/12

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 · 9/9/12

mình có đoạn code

Mã:

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é.

Mã:

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 · 9/9/12

concuarangme đã viết:
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 · 9/9/12

vodoi2x đã viết:
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 · 9/9/12

concuarangme đã viết:
đ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

PHP:

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 · 8/11/12

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!

PHP:

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 · 8/11/12

TránhXaRa đã viết:
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!

PHP:

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 · 8/11/12

TránhXaRa đã viết:
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!

PHP:

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 · 10/11/12

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 · 11/11/12

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

vanle33 · 11/11/12

nguyenthuy13388 đã viết:
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 · 11/11/12

nguyenthuy13388 đã viết:
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 · 13/11/12

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

TrungChinhs · 16/11/12

Chào các bạn ! Trong chủ đề Sort cột khi gộp nhiều Sheet bạn Ndu đã viết giúp tôi thủ tục này, tôi test thấy rất tốt (nhanh và chính xác) và đã áp dụng vào thực tế công việc của mình nhưng do tôi không hiểu nhiều về mảng nên không hiểu được thuật giải của đoạn code này. Vì vậy nhờ các bạn dịch nôm giúp tôi đoạn code sau để tôi có thêm tài liệu học về mảng. Xin chân thành cảm ơn !

Mã:

[COLOR=#0000BB][FONT=monospace]Sub Main[/FONT][/COLOR][COLOR=#007700][FONT=monospace]()
  [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Dim tmpArr[/FONT][/COLOR][COLOR=#007700][FONT=monospace], [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Arr[/FONT][/COLOR][COLOR=#007700][FONT=monospace]()
  [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Dim lR [/FONT][/COLOR][COLOR=#007700][FONT=monospace]As [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Long[/FONT][/COLOR][COLOR=#007700][FONT=monospace], [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]lC [/FONT][/COLOR][COLOR=#007700][FONT=monospace]As [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Long[/FONT][/COLOR][COLOR=#007700][FONT=monospace], [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]lCs [/FONT][/COLOR][COLOR=#007700][FONT=monospace]As [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Long[/FONT][/COLOR][COLOR=#007700][FONT=monospace], [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]i [/FONT][/COLOR][COLOR=#007700][FONT=monospace]As [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Long[/FONT][/COLOR][COLOR=#007700][FONT=monospace], [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]n [/FONT][/COLOR][COLOR=#007700][FONT=monospace]As [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Long[/FONT][/COLOR][COLOR=#007700][FONT=monospace], [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]lCPos [/FONT][/COLOR][COLOR=#007700][FONT=monospace]As [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Long
  Dim wks [/FONT][/COLOR][COLOR=#007700][FONT=monospace]As [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Worksheet[/FONT][/COLOR][COLOR=#007700][FONT=monospace], [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]wksDes [/FONT][/COLOR][COLOR=#007700][FONT=monospace]As [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Worksheet[/FONT][/COLOR][COLOR=#007700][FONT=monospace], [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Dic [/FONT][/COLOR][COLOR=#007700][FONT=monospace]As [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Object
  Dim sTitle [/FONT][/COLOR][COLOR=#007700][FONT=monospace]As [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]String
  On Error Resume Next
  Set Dic [/FONT][/COLOR][COLOR=#007700][FONT=monospace]= [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]CreateObject[/FONT][/COLOR][COLOR=#007700][FONT=monospace]([/FONT][/COLOR][COLOR=#DD0000][FONT=monospace]"Scripting.Dictionary"[/FONT][/COLOR][COLOR=#007700][FONT=monospace])
  [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Set wksDes [/FONT][/COLOR][COLOR=#007700][FONT=monospace]= [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Worksheets[/FONT][/COLOR][COLOR=#007700][FONT=monospace]([/FONT][/COLOR][COLOR=#DD0000][FONT=monospace]"Tong hop"[/FONT][/COLOR][COLOR=#007700][FONT=monospace])
  [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]wksDes[/FONT][/COLOR][COLOR=#007700][FONT=monospace].[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]UsedRange[/FONT][/COLOR][COLOR=#007700][FONT=monospace].[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]ClearContents
  ReDim Arr[/FONT][/COLOR][COLOR=#007700][FONT=monospace]([/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]1 To 60000[/FONT][/COLOR][COLOR=#007700][FONT=monospace], [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]1 To 1[/FONT][/COLOR][COLOR=#007700][FONT=monospace])
  For [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Each wks In ThisWorkbook[/FONT][/COLOR][COLOR=#007700][FONT=monospace].[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Worksheets
    [/FONT][/COLOR][COLOR=#007700][FONT=monospace]If [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]UCase[/FONT][/COLOR][COLOR=#007700][FONT=monospace]([/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]wks[/FONT][/COLOR][COLOR=#007700][FONT=monospace].[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Name[/FONT][/COLOR][COLOR=#007700][FONT=monospace]) <> [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]UCase[/FONT][/COLOR][COLOR=#007700][FONT=monospace]([/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]wksDes[/FONT][/COLOR][COLOR=#007700][FONT=monospace].[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Name[/FONT][/COLOR][COLOR=#007700][FONT=monospace]) [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Then
      tmpArr [/FONT][/COLOR][COLOR=#007700][FONT=monospace]= [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]wks[/FONT][/COLOR][COLOR=#007700][FONT=monospace].[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]UsedRange[/FONT][/COLOR][COLOR=#007700][FONT=monospace].[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Value
      [/FONT][/COLOR][COLOR=#007700][FONT=monospace]If [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]TypeName[/FONT][/COLOR][COLOR=#007700][FONT=monospace]([/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]tmpArr[/FONT][/COLOR][COLOR=#007700][FONT=monospace]) = [/FONT][/COLOR][COLOR=#DD0000][FONT=monospace]"Variant()" [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Then
        n [/FONT][/COLOR][COLOR=#007700][FONT=monospace]= [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]n [/FONT][/COLOR][COLOR=#007700][FONT=monospace]+ [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]1
        [/FONT][/COLOR][COLOR=#007700][FONT=monospace]For [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]lR [/FONT][/COLOR][COLOR=#007700][FONT=monospace]= [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]2 To UBound[/FONT][/COLOR][COLOR=#007700][FONT=monospace]([/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]tmpArr[/FONT][/COLOR][COLOR=#007700][FONT=monospace], [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]1[/FONT][/COLOR][COLOR=#007700][FONT=monospace])
          [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]n [/FONT][/COLOR][COLOR=#007700][FONT=monospace]= [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]n [/FONT][/COLOR][COLOR=#007700][FONT=monospace]+ [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]1
          [/FONT][/COLOR][COLOR=#007700][FONT=monospace]For [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]lC [/FONT][/COLOR][COLOR=#007700][FONT=monospace]= [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]1 To UBound[/FONT][/COLOR][COLOR=#007700][FONT=monospace]([/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]tmpArr[/FONT][/COLOR][COLOR=#007700][FONT=monospace], [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]2[/FONT][/COLOR][COLOR=#007700][FONT=monospace])
            [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]sTitle [/FONT][/COLOR][COLOR=#007700][FONT=monospace]= [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Trim[/FONT][/COLOR][COLOR=#007700][FONT=monospace]([/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]CStr[/FONT][/COLOR][COLOR=#007700][FONT=monospace]([/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]tmpArr[/FONT][/COLOR][COLOR=#007700][FONT=monospace]([/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]1[/FONT][/COLOR][COLOR=#007700][FONT=monospace], [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]lC[/FONT][/COLOR][COLOR=#007700][FONT=monospace])))
            If [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Len[/FONT][/COLOR][COLOR=#007700][FONT=monospace]([/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]sTitle[/FONT][/COLOR][COLOR=#007700][FONT=monospace]) [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Then
              [/FONT][/COLOR][COLOR=#007700][FONT=monospace]If [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Not Dic[/FONT][/COLOR][COLOR=#007700][FONT=monospace].[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Exists[/FONT][/COLOR][COLOR=#007700][FONT=monospace]([/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]sTitle[/FONT][/COLOR][COLOR=#007700][FONT=monospace]) [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Then
                lCs [/FONT][/COLOR][COLOR=#007700][FONT=monospace]= [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]lCs [/FONT][/COLOR][COLOR=#007700][FONT=monospace]+ [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]1
                Dic[/FONT][/COLOR][COLOR=#007700][FONT=monospace].[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Add sTitle[/FONT][/COLOR][COLOR=#007700][FONT=monospace], [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]lCs
                [/FONT][/COLOR][COLOR=#007700][FONT=monospace]If [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]UBound[/FONT][/COLOR][COLOR=#007700][FONT=monospace]([/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Arr[/FONT][/COLOR][COLOR=#007700][FONT=monospace], [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]2[/FONT][/COLOR][COLOR=#007700][FONT=monospace]) < [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]lCs Then ReDim Preserve Arr[/FONT][/COLOR][COLOR=#007700][FONT=monospace]([/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]1 To 60000[/FONT][/COLOR][COLOR=#007700][FONT=monospace], [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]1 To lCs[/FONT][/COLOR][COLOR=#007700][FONT=monospace])
                [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Arr[/FONT][/COLOR][COLOR=#007700][FONT=monospace]([/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]1[/FONT][/COLOR][COLOR=#007700][FONT=monospace], [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]lCs[/FONT][/COLOR][COLOR=#007700][FONT=monospace]) = [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]sTitle
                Arr[/FONT][/COLOR][COLOR=#007700][FONT=monospace]([/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]n[/FONT][/COLOR][COLOR=#007700][FONT=monospace], [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]lCs[/FONT][/COLOR][COLOR=#007700][FONT=monospace]) = [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]tmpArr[/FONT][/COLOR][COLOR=#007700][FONT=monospace]([/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]lR[/FONT][/COLOR][COLOR=#007700][FONT=monospace], [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]lC[/FONT][/COLOR][COLOR=#007700][FONT=monospace])
              Else
                [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]lCPos [/FONT][/COLOR][COLOR=#007700][FONT=monospace]= [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Dic[/FONT][/COLOR][COLOR=#007700][FONT=monospace].[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Item[/FONT][/COLOR][COLOR=#007700][FONT=monospace]([/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]sTitle[/FONT][/COLOR][COLOR=#007700][FONT=monospace])
                [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Arr[/FONT][/COLOR][COLOR=#007700][FONT=monospace]([/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]n[/FONT][/COLOR][COLOR=#007700][FONT=monospace], [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]lCPos[/FONT][/COLOR][COLOR=#007700][FONT=monospace]) = [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]tmpArr[/FONT][/COLOR][COLOR=#007700][FONT=monospace]([/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]lR[/FONT][/COLOR][COLOR=#007700][FONT=monospace], [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]lC[/FONT][/COLOR][COLOR=#007700][FONT=monospace])
              [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]End [/FONT][/COLOR][COLOR=#007700][FONT=monospace]If
            [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]End [/FONT][/COLOR][COLOR=#007700][FONT=monospace]If
          [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Next lC
        Next lR
      End [/FONT][/COLOR][COLOR=#007700][FONT=monospace]If
    [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]End [/FONT][/COLOR][COLOR=#007700][FONT=monospace]If
  [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Next wks
  [/FONT][/COLOR][COLOR=#007700][FONT=monospace]If [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]n [/FONT][/COLOR][COLOR=#007700][FONT=monospace]* [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]lCs Then
    With wksDes[/FONT][/COLOR][COLOR=#007700][FONT=monospace].[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Range[/FONT][/COLOR][COLOR=#007700][FONT=monospace]([/FONT][/COLOR][COLOR=#DD0000][FONT=monospace]"A3"[/FONT][/COLOR][COLOR=#007700][FONT=monospace]).[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Resize[/FONT][/COLOR][COLOR=#007700][FONT=monospace]([/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]n[/FONT][/COLOR][COLOR=#007700][FONT=monospace], [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]lCs[/FONT][/COLOR][COLOR=#007700][FONT=monospace])
      .[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Value [/FONT][/COLOR][COLOR=#007700][FONT=monospace]= [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Arr
      [/FONT][/COLOR][COLOR=#007700][FONT=monospace].[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Sort [/FONT][/COLOR][COLOR=#007700][FONT=monospace].[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Rows[/FONT][/COLOR][COLOR=#007700][FONT=monospace]([/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]1[/FONT][/COLOR][COLOR=#007700][FONT=monospace]), [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]1[/FONT][/COLOR][COLOR=#007700][FONT=monospace], , , , , , [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]xlYes[/FONT][/COLOR][COLOR=#007700][FONT=monospace], , , [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]xlLeftToRight
    End With
  End [/FONT][/COLOR][COLOR=#007700][FONT=monospace]If
[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]End Sub [/FONT][/COLOR]

ndu96081631 · 16/11/12

TrungChinhs đã viết:
Chào các bạn ! Trong chủ đề Sort cột khi gộp nhiều Sheet bạn Ndu đã viết giúp tôi thủ tục này, tôi test thấy rất tốt (nhanh và chính xác) và đã áp dụng vào thực tế công việc của mình nhưng do tôi không hiểu nhiều về mảng nên không hiểu được thuật giải của đoạn code này. Vì vậy nhờ các bạn dịch nôm giúp tôi đoạn code sau để tôi có thêm tài liệu học về mảng. Xin chân thành cảm ơn !

Phải thêm file đính kèm để minh họa nữa anh à!
Nói thiệt, dù là em viết code này, giờ xem lại em cũng quên tuốt, chẳng nhớ nó dùng vào việc gì nữa
Ẹc... Ẹc...

TrungChinhs · 16/11/12

ndu96081631 đã viết:
Phải thêm file đính kèm để minh họa nữa anh à!
Nói thiệt, dù là em viết code này, giờ xem lại em cũng quên tuốt, chẳng nhớ nó dùng vào việc gì nữa
Ẹc... Ẹc...

File gồm 3 Sheet: 2 sheet dữ liệu nguồn và sheet Tong hop (kết quả trong Sheet Tong Hop tôi chạy từ code trên).
Yêu cầu là lấy dữ liệu của các hộ từ nhiều sheet về sheet Tong hop và phải đúng cột. Các vấn đề còn lại như Format bảng tính, Cộng tổng không cần quan tâm. Thực tế mỗi sheet là một file, khi post lên tôi gộp thành 1 file nên chưa có code.
Tuấn cố giúp mình nhé, đối với mình bài này rất quan trọng.

thanhlanh · 17/11/12

TrungChinhs đã viết:
Chào các bạn ! Trong chủ đề Sort cột khi gộp nhiều Sheet bạn Ndu đã viết giúp tôi thủ tục này, tôi test thấy rất tốt (nhanh và chính xác) và đã áp dụng vào thực tế công việc của mình nhưng do tôi không hiểu nhiều về mảng nên không hiểu được thuật giải của đoạn code này. Vì vậy nhờ các bạn dịch nôm giúp tôi đoạn code sau để tôi có thêm tài liệu học về mảng. Xin chân thành cảm ơn !]

Biết là tác giả lười mấy cái vụ này nên mình biết tới đâu nói tới đó, có gì tác giả chỉnh nha

Mã:

Sub Main()
    Dim tmpArr, Arr()
    Dim lR As Long, lC As Long, lCs As Long, i As Long, n As Long, lCPos As Long
    Dim wks As Worksheet, wksDes As Worksheet, Dic As Object
    Dim sTitle As String
    On Error Resume Next
    Set Dic = CreateObject("Scripting.Dictionary")
    Set wksDes = Worksheets("Tong hop")
    wksDes.UsedRange.ClearContents    ' Xóa hết dữ liệu trong sheet Tong hop
    ReDim Arr(1 To 60000, 1 To 1)    ' Khởi tạo mảng Arr có 60000 dòng và một cột
    For Each wks In ThisWorkbook.Worksheets    ' Duyệt qua tất cả các sheet
        If UCase(wks.Name) <> UCase(wksDes.Name) Then    ' nếu sheet nào có tên khác "tong hơp" (không phân biệt chữ thường hay hoa) thì
            tmpArr = wks.UsedRange.Value    ' chuyển sheet đó thành một mảng tmpArr rồi xét tiếp:
            If TypeName(tmpArr) = "Variant()" Then    ' nếu kiểu dữ liệu của tmpArr đúng là mảng hay nói cách khác nếu mảng tmpArr có nhiều hơn một phần tử thì:
                n = n + 1
                For lR = 2 To UBound(tmpArr, 1)    ' duyệt từ dòng thứ 2 đến dòng cuối cùng của mảng tmpArr; ( (UBound(tmpArr, 1) là kích thước chiều thứ nhất của mảng tmpArr)
                    n = n + 1
                    For lC = 1 To UBound(tmpArr, 2)    ' trong từng dòng lR, duyệt từ cột thứ nhất đến cột cuối cùng
                        sTitle = Trim(CStr(tmpArr(1, lC)))    ' gọi sTitle là phần tử thuộc hàng thứ nhất, cột đang xét của mảng tmpArr (hàm trim bạn thừa biết, tác giả còn thêm hàm CStr để biến dữ liệu thành chuỗi? - nhờ tác giả giải thích mục đích, nếu là mình sẽ không đặt câu này ở đây)
                        If Len(sTitle) Then    ' nếu sTitle có chứa ký tự (có thể viết If sTitle <> "")
                            If Not Dic.Exists(sTitle) Then    ' nếu sTitle chưa có trong danh sách của Dic thì
                                lCs = lCs + 1    ' thêm một phần tử vào danh sách của Dic
                                Dic.Add sTitle, lCs    ' phần tử đó chính là sTitle và có Item là lCs
                                If UBound(Arr, 2) < lCs Then ReDim Preserve Arr(1 To 60000, 1 To lCs)    ' nếu số cột (chiều thứ 2) của mảng Arr < lCs thì mở rộng chiều thứ hai của mảng bằng với lCs
                                Arr(1, lCs) = sTitle    ' Gán phần tử ở dòng thứ nhất, cột thứ lCs của mảng Arrthành sTitle (tiêu đề)
                                Arr(n, lCs) = tmpArr(lR, lC)    ' Gán phần tử ở dòng thứ n, cột thứ lCs của mảng Arr bằng phần tử đang xét của mảng tmpArr (chứa dữ liệu của sheet đang xét)
                            Else    ' nếu sTitle đã có trong danh sách của Dic thì
                                lCPos = Dic.Item(sTitle)    ' lấy Item của sTitle trong Dic (xem nó đã nằm ở cột nào trong mảng Arr)
                                Arr(n, lCPos) = tmpArr(lR, lC)    ' Gán phần tử ở dòng thứ n, cột thứ lCPos của mảng Arr bằng phần tử đang xét của mảng tmpArr
                            End If
                        End If
                    Next lC
                Next lR
            End If
        End If
    Next wks
    If n * lCs Then    ' nếu tổng số dòng (không tính tiêu đề) và tổng số cột của mảng Arr đều >=1
        With wksDes.Range("A3").Resize(n, lCs)
            .Value = Arr    ' gán mảng Arr xuống range
            .Sort .Rows(1), 1, , , , , , xlYes, , , xlLeftToRight    ' sắp xếp theo abc thứ tự cột
        End With
    End If
End Sub

ndu96081631 · 17/11/12

thanhlanh đã viết:
Biết là tác giả lười mấy cái vụ này nên mình biết tới đâu nói tới đó, có gì tác giả chỉnh nha

Mã:

Sub Main() If Not Dic.Exists(sTitle) Then lCs = lCs + 1 Dic.Add sTitle, lCs If UBound(Arr, 2) < lCs Then ReDim Preserve Arr(1 To 60000, 1 To lCs) Arr(1, lCs) = sTitle Arr(n, lCs) = tmpArr(lR, lC) Else lCPos = Dic.Item(sTitle) Arr(n, lCPos) = tmpArr(lR, lC) End If End Sub

Chổ này nói đơn giản là vầy:
- Nếu xét thấy sTitle chưa có trong Dic thì gán vào, đồng thời xác định luôn vị trí của sTitle (bằng lCs)
- Ngược lại, nếu thấy sTitle đã có trong Dic thì xem nó đang nằm ở vị trí thứ mấy (dựa vào Dic.Item(sTitle)..) để gán tmpArr(lR, lC) vào đúng vị trí
Vậy thôi

thanhlanh · 17/11/12

ndu96081631 đã viết:
Chổ này nói đơn giản là vầy:
- Nếu xét thấy sTitle chưa có trong Dic thì gán vào, đồng thời xác định luôn vị trí của sTitle (bằng lCs)
- Ngược lại, nếu thấy sTitle đã có trong Dic thì xem nó đang nằm ở vị trí thứ mấy (dựa vào Dic.Item(sTitle)..) để gán tmpArr(lR, lC) vào đúng vị trí
Vậy thôi

Ừ, mình giải thích không chỉ cho anh TrungChinhs mà cho cả những ai mới chập chững như ...mình.
Như trên mình có thắc mắc trong câu sTitle = Trim(CStr(tmpArr(1, lC)))
ndu dùng hàm CStr để làm gì?

ndu96081631 · 17/11/12

thanhlanh đã viết:
Ừ, mình giải thích không chỉ cho anh TrungChinhs mà cho cả những ai mới chập chững như ...mình.
Như trên mình có thắc mắc trong câu sTitle = Trim(CStr(tmpArr(1, lC)))
ndu dùng hàm CStr để làm gì?

Chuyển nó về dạng String thôi mà mà anh
Có nhiều nguyên nhân khiến ta phải làm việc này nhưng nói nôm na thế này:
- Anh có biến tmp khai báo dạng Variant và anh so sánh tmp > 0 thì đồng nghĩa anh xem tmp là Number (Excel sẽ tự chuyển tmp sang kiểu Long hoặc Double gì đó)
- Anh có biến tmp khai báo dạng Variant và anh so sánh tmp <> "" thì đồng nghĩa anh xem tmp là Text (Excel sẽ tự chuyển tmp sang kiểu String)
- Bây giờ anh so sánh thế này: CLng(tmp) > 0 hoặc CStr(tmp) <> "" hoặc Len(CStr(tmp)) > 0 là anh là chủ động làm công việc chuyển đổi thay cho Excel ---> Giúp cho Excel đở bị "tai biến mạch máu"
Ẹc... Ẹc...

TrungChinhs · 17/11/12

Xin cảm ơn ThanhLanh và Ndu ! đã giúp. Tôi sẽ nghiên cứu tiếp nếu có gì cần hỏi mong các bạn tiếp tục giúp đỡ.

ndu96081631 · 18/11/12

TrungChinhs đã viết:
Xin cảm ơn ThanhLanh và Ndu ! đã giúp. Tôi sẽ nghiên cứu tiếp nếu có gì cần hỏi mong các bạn tiếp tục giúp đỡ.

Em nói thêm:
- Bài này mấu chốt nằm ở việc xác định chính xác vùng dữ liệu hoạt động.
- Trong code em dùng tmpArr = wks.UsedRange.Value rồi qua đó xác định sTitle là dòng đầu tiên của tmpArr
- Tuy nhiên điều này cũng khá nguy hiểm. Trong trường hợp dữ liệu của anh xuất phát không phải từ dòng 1 và cột A thì UsedRange có thể xác định sai
- Để kiểm tra, anh có thể đứng tại 1 sheet bất kỳ rồi chạy dòng lệnh ActiveSheet.UsedRange.Select xem nó "chọn" cái gì nhé

thanhlanh · 18/11/12

ndu96081631 đã viết:
Em nói thêm:
- Bài này mấu chốt nằm ở việc xác định chính xác vùng dữ liệu hoạt động.
- Trong code em dùng tmpArr = wks.UsedRange.Value rồi qua đó xác định sTitle là dòng đầu tiên của tmpArr
- Tuy nhiên điều này cũng khá nguy hiểm. Trong trường hợp dữ liệu của anh xuất phát không phải từ dòng 1 và cột A thì UsedRange có thể xác định sai
- Để kiểm tra, anh có thể đứng tại 1 sheet bất kỳ rồi chạy dòng lệnh ActiveSheet.UsedRange.Select xem nó "chọn" cái gì nhé

Nếu phía trên bảng có tiêu đề hoặc rác thì ... tèo.
Vậy thì thay tmpArr = wks.UsedRange.Valuethành tmpArr = wks.Range("c3").CurrentRegion.Value cho an toàn
Tất nhiên dữ liệu các Sheet cũng phải nằm trong khuôn khổ nhất định.

Hoàng Trọng Nghĩa · 18/11/12

thanhlanh đã viết:
Nếu phía trên bảng có tiêu đề hoặc rác thì ... tèo.
Vậy thì thay tmpArr = wks.UsedRange.Valuethành tmpArr = wks.Range("c3").CurrentRegion.Value cho an toàn
Tất nhiên dữ liệu các Sheet cũng phải nằm trong khuôn khổ nhất định.

Với điều kiện là hàng 2 (Row thứ 2) không có bất cứ dữ liệu nào liền kề với dữ liệu từ hàng thứ 3 thì mới thực hiện được nha anh!

Nói chung hàng cận trên và cận dưới không được liền kề. Với thủ tục này nó chỉ lấy những gì liên quan và liền kề từ ô C3 mà thôi. Chơi cái này nguy hiểm quá!

Tốt nhất mình xác định cột nào là cột chính trong một bảng dữ liệu rồi lấy ô đầu và ô cuối của cột đó resize số cột ra cho chắc ăn.

ndu96081631 · 18/11/12

thanhlanh đã viết:
Nếu phía trên bảng có tiêu đề hoặc rác thì ... tèo.
Vậy thì thay tmpArr = wks.UsedRange.Valuethành tmpArr = wks.Range("c3").CurrentRegion.Value cho an toàn
Tất nhiên dữ liệu các Sheet cũng phải nằm trong khuôn khổ nhất định.

Lần trước anh TrungChinhs đã nói dữ liệu tại các sheet không biết bắt đầu từ đâu nên không thể dùng CurrentRegion được anh à (có biết cell nào là cell bắt đầu đâu).
Thêm nữa, anh có để ý thấy trong file có nguyên dòng 5 rổng đấy ----> Nếu CurrentRegion cùng lắm chỉ chọn được cái tiêu đề

thanhlanh · 18/11/12

ndu96081631 đã viết:
Lần trước anh TrungChinhs đã nói dữ liệu tại các sheet không biết bắt đầu từ đâu nên không thể dùng CurrentRegion được anh à (có biết cell nào là cell bắt đầu đâu).
Thêm nữa, anh có để ý thấy trong file có nguyên dòng 5 rổng đấy ----> Nếu CurrentRegion cùng lắm chỉ chọn được cái tiêu đề

... í í, bạn đừng nóng, mình muốn nhắn nhủ (bàn) với chủ xị là: "Tất nhiên dữ liệu các Sheet cũng phải nằm trong khuôn khổ nhất định" để có thêm một phương án thôi.

TrungChinhs · 18/11/12

Cảm ơn các bạn. Vấn đề xác định vùng dữ liệu thì đúng là nan giải, với hàng trăm giả thiết thì việc chọn một phương án tổng thể gần như là nhiệm vụ bất khả thi... Khi làm việc với các bảng tính tôi nhận thấy hầu hết (không phải tất cả) đầu bảng đều bắt đầu là cột số thứ tự với ký hiệu là "stt" vì vậy tôi thường dùng code sau để xác định vùng bảng (không bao gồm tên biểu).

Mã:

Sub Table()
    With ActiveSheet
        Set RngTL = .UsedRange.Find("Stt", , , 2, 1, 1)
        Set RngLR = .UsedRange.Find("*", , , 2, 2, 2)
        Set RngTR = .Cells(RngTL.Row, RngLR.Column)
        Set RngLL = RngTL(65000).End(3)(2)
        sR = RngLR.Row - RngTL.Row + 1
        sCl = RngLR.Column - RngTL.Column + 1
    End With
End Sub

Ví dụ: trong code các bạn viết là UsedRange.Value thì khi áp dụng tôi sửa thành RngTL.Resize(sR, sCl).Value
...

Đối với những người dùng code tôi viết đều phải tuân thủ nguyên tắc: Đầu biểu có thể nằm bất cứ đâu nhưng phải ký hiệu là "stt", cuối bảng (bên phải và dưới bảng) phải sạch.

ndu96081631 · 19/11/12

TrungChinhs đã viết:
Cảm ơn các bạn. Vấn đề xác định vùng dữ liệu thì đúng là nan giải, với hàng trăm giả thiết thì việc chọn một phương án tổng thể gần như là nhiệm vụ bất khả thi... Khi làm việc với các bảng tính tôi nhận thấy hầu hết (không phải tất cả) đầu bảng đều bắt đầu là cột số thứ tự với ký hiệu là "stt" vì vậy tôi thường dùng code sau để xác định vùng bảng (không bao gồm tên biểu).

Mã:

Sub Table() With ActiveSheet Set RngTL = .UsedRange.Find("Stt", , , 2, 1, 1) Set RngLR = .UsedRange.Find("*", , , 2, 2, 2) Set RngTR = .Cells(RngTL.Row, RngLR.Column) Set RngLL = RngTL(65000).End(3)(2) sR = RngLR.Row - RngTL.Row + 1 sCl = RngLR.Column - RngTL.Column + 1 End With End Sub

Ví dụ: trong code các bạn viết là UsedRange.Value thì khi áp dụng tôi sửa thành RngTL.Resize(sR, sCl).Value
...

Đối với những người dùng code tôi viết đều phải tuân thủ nguyên tắc: Đầu biểu có thể nằm bất cứ đâu nhưng phải ký hiệu là "stt", cuối bảng (bên phải và dưới bảng) phải sạch.

Cho dù anh xác định được chính xác vùng dữ liệu thì vẫn còn có 1 trở ngại nữa: Em để ý thấy file của anh có Merge Cell tại tiêu đề ---> Vậy thì việc xác định sTitle cũng xem như.. THUA
Đã gọi là CSDL chuẩn thì việc Merge Cell coi như 1 cấm kỵ ---> Ngay cả các công cụ hàng đầu của MS như PivotTable, Advanced Filter và thậm chí là cả ADO cũng không xử lý nỗi dữ liệu loại này

cuong0202 · 25/11/12

trích dữ liệu từ sheet tổng ra sheet chi tiết

Chào cả nhà,, chúc cả nhà đầy sức khỏe.

Em nhớ lúc trước có đọc được một file dùng macro để tạo ra các sheet chi tiết từ một sheet tổng, nhưng em kiếm mấy ngày nay không được, đành nhờ mọi người giúp đỡ .

Đại khái nó giống như file em đính kèm.
Chân thành cảm ơn mọi người.

dongducnhiem · 25/11/12

cuong0202 đã viết:
Chào cả nhà,, chúc cả nhà đầy sức khỏe.

Em nhớ lúc trước có đọc được một file dùng macro để tạo ra các sheet chi tiết từ một sheet tổng, nhưng em kiếm mấy ngày nay không được, đành nhờ mọi người giúp đỡ .

Đại khái nó giống như file em đính kèm.
Chân thành cảm ơn mọi người.

Bạn tham khảo đề tài này thử xem, có nhiều cách
http://www.giaiphapexcel.com/forum/...-dữ-liệu-từ-01-sheet-tổng-sang-các-sheet-khác

cuong0202 · 25/11/12

dongducnhiem đã viết:
Bạn tham khảo đề tài này thử xem, có nhiều cách
http://www.giaiphapexcel.com/forum/...-dữ-liệu-từ-01-sheet-tổng-sang-các-sheet-khác

CẢM ƠN BẠN,, rất bổ ích,,, nhưng chưa phải cái mình cần tìm,, cái mình muốn tim,, khi click 1 cái vào nút LOC,, nó sẽ hiển thị tất cả các sheet chi tiết,, như file mình đính kèm [mình chỉ ví dụ 3 sheet tiêu biều, khi chạy nó sẽ ra tất cả các sheet]

Quang_Hải · 25/11/12

cuong0202 đã viết:
CẢM ƠN BẠN,, rất bổ ích,,, nhưng chưa phải cái mình cần tìm,, cái mình muốn tim,, khi click 1 cái vào nút LOC,, nó sẽ hiển thị tất cả các sheet chi tiết,, như file mình đính kèm [mình chỉ ví dụ 3 sheet tiêu biều, khi chạy nó sẽ ra tất cả các sheet]

Tặng bạn file này mình đang sử dụng. Tuỳ biến theo yêu câu của bạn. File của bạn trộn cell sẽ không chạy được phải sửa code lai. Cột 8 của bạn chứa các ký tự không thể đặt tên sheet

vanphonqltc · 29/11/12

Viết Code VBA cho cột, báo cáo sổ cái tài khoản

Chào các bạn, Mình có 1 file cần viết code VBA để làm báo cáo, nhưng minh chua biết nhiều về VBA. Nhờ mọi người giúp đỡ, Mình cảm ơn rất nhiều. Xin xem file đính kèm

phanxipang · 8/12/12

quanghai1969 đã viết:
Tặng bạn file này mình đang sử dụng. Tuỳ biến theo yêu câu của bạn. File của bạn trộn cell sẽ không chạy được phải sửa code lai. Cột 8 của bạn chứa các ký tự không thể đặt tên sheet

chào bạn quanghai
file của bạn rất hay, tôi áp dụng thấy rất tốt, nhưng có 1 vấn đề mong bạn giúp, khi tôi thêm 1 sheet nữa có số liệu để tính toán nhưng khi bấm command thì tách ra thì không sao nhưng khi ghép vào nó ghép cả sheet mới tạo và xoá luôn sheet đó, vậy phải sửa code thề nào để nó không xoá sheet đo và ko copy dữ liệu sheet đó vào sheet "TỔNG HỢP", tôi đặt tên sheet mới tạo là "PBQL". XIN CẢM ƠN BẠN
For Each sh In ThisWorkbook.Worksheets
' If sh.Name = "PBQL" Then
If sh.Name <> "TONG HOP" Then
sh.Range(sh.[A3], sh.[J65536].End(3)).Copy _
Sheets("TONG HOP").[A65536].End(3).Offset(1)
sh.Delete
End If

Quang_Hải · 8/12/12

phanxipang đã viết:
chào bạn quanghai
file của bạn rất hay, tôi áp dụng thấy rất tốt, nhưng có 1 vấn đề mong bạn giúp, khi tôi thêm 1 sheet nữa có số liệu để tính toán nhưng khi bấm command thì tách ra thì không sao nhưng khi ghép vào nó ghép cả sheet mới tạo và xoá luôn sheet đó, vậy phải sửa code thề nào để nó không xoá sheet đo và ko copy dữ liệu sheet đó vào sheet "TỔNG HỢP", tôi đặt tên sheet mới tạo là "PBQL". XIN CẢM ƠN BẠN
For Each sh In ThisWorkbook.Worksheets
' If sh.Name = "PBQL" Then
If sh.Name <> "TONG HOP" Then
sh.Range(sh.[A3], sh.[J65536].End(3)).Copy _
Sheets("TONG HOP").[A65536].End(3).Offset(1)
sh.Delete
End If

Thử sửa vầy xem thế nào:

If sh.Name <> "TONG HOP" And sh.Name <> "PBQL" Then

phanxipang · 8/12/12

Cám ơn bạn rất nhiều, cú pháp này mà tôi mò mãi không ra. cảm ơn bạn nhé, rất ok rồi

dat005 · 13/12/12

Xin chào mọi người. Cho mình hỏi một chút. Mình tập viết một đoạn code. Nhưng không hiểu vì sao đã qua thời gian ấn định trước trong VBA mà excel không thay đổi giá tri ở ô A1 mà phải ấn Run thì mới chạy. Xin mọi người chỉ giúp.

Sub locksheet()
Application.ScreenUpdating = True
Dim mytime
Dim mytime1
Dim timenow
Sheets("dat").Activate
mytime = TimeValue("10:04:00 AM")
mytime1 = TimeValue("1:52:00 PM")
timenow = Time()
If timenow > mytime1 Then
Range("a1").Value = "50000"
End If
Application.ScreenUpdating = True
End Sub

Xin cảm ơn.

dat005 · 13/12/12

VBA không chạy tư động khi viết chương trình.

Xin chào mọi người. Cho mình hỏi một chút. Mình tập viết một đoạn code. Nhưng không hiểu vì sao đã qua thời gian ấn định trước trong VBA mà excel không thay đổi giá tri ở ô A1 mà phải ấn Run thì mới chạy. Xin mọi người chỉ giúp.

Sub locksheet()
Application.ScreenUpdating = True
Dim mytime
Dim mytime1
Dim timenow
Sheets("dat").Activate
mytime = TimeValue("10:04:00 AM")
mytime1 = TimeValue("1:52:00 PM")
timenow = Time()
If timenow > mytime1 Then
Range("a1").Value = "50000"
End If
Application.ScreenUpdating = True
End Sub

Xin cảm ơn.

Quang_Hải · 13/12/12

Sub tudong()
.........
End Sub

Sub Aut

pen()
Application.OnTime TimeValue("16:00:00"), "tudong"
End Sub

Đúng 16g thì Sub tudong sẽ hoạt động

dat005 · 13/12/12

Như vậy thì giả sử sau 16h chường trình excel mới bật lên thì auto_open có hoạt động được không.

Quang_Hải · 13/12/12

dat005 đã viết:
Như vậy thì giả sử sau 16h chường trình excel mới bật lên thì auto_open có hoạt động được không.

Đương nhiên là không rồi.

nguyenkhoadng · 15/12/12

Code In bảng tính

Mã:

Private Sub CommandButton1_Click()If Opt1 Then
    Dim lngRow As Long
    lngRow = Application.WorksheetFunction.Count(ActiveSheet.Range("O:O"))
    With ActiveSheet.Range("A2:Q" & lngRow + 7)
        .Select
        .PrintOut Copies:=1, Preview:=True, Collate:=True
    End With
Else
    Dim lngRow As Long
    lngRow = Application.WorksheetFunction.Count(ActiveSheet.Range("U:U"))
    With ActiveSheet.Range("S2:X" & lngRow + 7)
        .Select
        .PrintOut Copies:=1, Preview:=True, Collate:=True
    End With
End If
End Sub


Private Sub CommandButton2_Click()
    Unload Me
End Sub

Mình sử dụng đoạn code trên cho vào form để thực hiện in bảng tính.
nhưng khi thực hiện lệnh thì vào đến trang preview là bị đứng, và vẫn hiện cái form in, ko thể nào tắt được.
Nhờ các bạn giúp mình xem đoạn code trên với.
Mình cảm ơn!

xuan.nguyen82 · 15/12/12

nguyenkhoadng đã viết:
.............................
Mình sử dụng đoạn code trên cho vào form để thực hiện in bảng tính.
nhưng khi thực hiện lệnh thì vào đến trang preview là bị đứng, và vẫn hiện cái form in, ko thể nào tắt được.
Nhờ các bạn giúp mình xem đoạn code trên với.
Mình cảm ơn!

Code có vẻ như không có lỗi gì, mình nghĩ là có thể do đang ở chế độ Print Preview nên bạn không tác động đến Form được. Bạn thử nhấn ESC để thoát khỏi chế độ Print Preview xem sao.

Mà hình như câu lệnh .Select ở trên hơi thừa hay sao ấy nhỉ?!

nguyenkhoadng · 15/12/12

xuan.nguyen82 đã viết:
Code có vẻ như không có lỗi gì, mình nghĩ là có thể do đang ở chế độ Print Preview nên bạn không tác động đến Form được. Bạn thử nhấn ESC để thoát khỏi chế độ Print Preview xem sao.

Mà hình như câu lệnh .Select ở trên hơi thừa hay sao ấy nhỉ?!

Với form trên khi vào đến cửa sổ preview thì bị đứng như hình mình đính kèm bên dưới.
Nhờ bạn nào biết nguyên nhân giúp mình khắc phục với.
Mình cảm ơn!

Hoàng Trọng Nghĩa · 15/12/12

nguyenkhoadng đã viết:
Với form trên khi vào đến cửa sổ preview thì bị đứng như hình mình đính kèm bên dưới.
Nhờ bạn nào biết nguyên nhân giúp mình khắc phục với.
Mình cảm ơn!

Bạn gửi file lên đi, chứ nhìn hình không đoán được bệnh gì đâu.

Bạn có nhất thiết phải thấy Print Review trước khi in không?

nguyenkhoadng · 15/12/12

Hoàng Trọng Nghĩa đã viết:
Bạn gửi file lên đi, chứ nhìn hình không đoán được bệnh gì đâu.

Bạn có nhất thiết phải thấy Print Review trước khi in không?

Mình đính kèm file bên dưới.
Ko biết lỗi gì nhờ các bạn giúp.

Hoàng Trọng Nghĩa · 15/12/12

nguyenkhoadng đã viết:
Mình đính kèm file bên dưới.
Ko biết lỗi gì nhờ các bạn giúp.

Nếu in thì không hiện Print Review:

Mã:

Private Sub CommandButton1_Click()
    Dim lngRow As Long
    If Opt1 Then
        lngRow = Application.WorksheetFunction.Count(ActiveSheet.Range("O:O"))
        With ActiveSheet.Range("A2:Q" & lngRow + 7)
            .Select
            .PrintOut Copies:=1, Collate:=True
        End With
    Else
        lngRow = Application.WorksheetFunction.Count(ActiveSheet.Range("U:U"))
        With ActiveSheet.Range("S2:X" & lngRow + 7)
            .Select
            .PrintOut Copies:=1, Collate:=True
        End With
    End If
    Unload Me
End Sub

nguyenkhoadng · 15/12/12

Hoàng Trọng Nghĩa đã viết:

Nếu in thì không hiện Print Review:

Mã:

Private Sub CommandButton1_Click()
    Dim lngRow As Long
    If Opt1 Then
        lngRow = Application.WorksheetFunction.Count(ActiveSheet.Range("O:O"))
        With ActiveSheet.Range("A2:Q" & lngRow + 7)
            .Select
            .PrintOut Copies:=1, Collate:=True
        End With
    Else
        lngRow = Application.WorksheetFunction.Count(ActiveSheet.Range("U:U"))
        With ActiveSheet.Range("S2:X" & lngRow + 7)
            .Select
            .PrintOut Copies:=1, Collate:=True
        End With
    End If
    Unload Me
End Sub

mình muốn vào preview để có thể thay đổi máy in, hoặc 1 vài tùy chọn khác. vậy nếu ko vào preview thì có cách nào khác ko?

Good-Luck · 15/12/12

cảm phiềm các ACE Sư huynh (tỉ), cho hỏi có cách nào cho phép ở môi trường VBE gõ được unicode tiếng việt ko???

Hoàng Trọng Nghĩa · 16/12/12

Good-Luck đã viết:
cảm phiềm các ACE Sư huynh (tỉ), cho hỏi có cách nào cho phép ở môi trường VBE gõ được unicode tiếng việt ko???

Có thể gõ tiếng Việt bằng font khác như VNI còn Unicode thì không thể gõ được. Vì vậy diễn đàn có rất nhiều bài dùng các hàm chuyển đổi font cho môi trường VBE.

Hong.Van · 16/12/12

Hoàng Trọng Nghĩa đã viết:
Có thể gõ tiếng Việt bằng font khác như VNI còn Unicode thì không thể gõ được. Vì vậy diễn đàn có rất nhiều bài dùng các hàm chuyển đổi font cho môi trường VBE.

Trước đây em có thấy bài của thành viên Siwtom , nhưng bây giờ tìm không ra!
Nhân đây cho em hỏi, các Thầy hoặc anh chị có code nào để sắp xếp lại code thụt ra , thụt vào không? em có tải File của tác giả Phan Ngoc Lan (!?) nhưng kg dùng được, Ai có cho em xin!
Em cảm ơn

Hoàng Trọng Nghĩa · 16/12/12

Hong.Van đã viết:
Trước đây em có thấy bài của thành viên Siwtom , nhưng bây giờ tìm không ra!
Nhân đây cho em hỏi, các Thầy hoặc anh chị có code nào để sắp xếp lại code thụt ra , thụt vào không? em có tải File của tác giả Phan Ngoc Lan (!?) nhưng kg dùng được, Ai có cho em xin!
Em cảm ơn

Tiện ích thì cũng tốt, nhưng theo tôi thì tôi có thói quen tự canh ( bằng phím Tab >> và Shift + Tab << ), khi làm như vậy mình dễ chỉnh sửa trong code hơn là mình làm một loạt rồi mới canh thụt ra thụt vào.

ptm0412 · 16/12/12

Hong.Van đã viết:
Trước đây em có thấy bài của thành viên Siwtom , nhưng bây giờ tìm không ra!
Nhân đây cho em hỏi, các Thầy hoặc anh chị có code nào để sắp xếp lại code thụt ra , thụt vào không? em có tải File của tác giả Phan Ngoc Lan (!?) nhưng kg dùng được, Ai có cho em xin!
Em cảm ơn

tất cả các bài của siwtom đều gõ unicode trong môi trường VBA, một số bài có câu ghi chú nên dùng font gì để gõ: Courier New (Vietnamese), bảng mã Unicode tổ hợp

Thụt ra thụt vào:
tab 1 cái thì vào, enter 1 cái thì ngay hàng, back 1 cái thì thò ra
Hoặc cho hiện toolbar Edit rồi nhấn nút indent, outdent như word.

nguyenkhoadng · 16/12/12

Hoàng Trọng Nghĩa đã viết:

Nếu in thì không hiện Print Review:

Mã:

Private Sub CommandButton1_Click()
    Dim lngRow As Long
    If Opt1 Then
        lngRow = Application.WorksheetFunction.Count(ActiveSheet.Range("O:O"))
        With ActiveSheet.Range("A2:Q" & lngRow + 7)
            .Select
            .PrintOut Copies:=1, Collate:=True
        End With
    Else
        lngRow = Application.WorksheetFunction.Count(ActiveSheet.Range("U:U"))
        With ActiveSheet.Range("S2:X" & lngRow + 7)
            .Select
            .PrintOut Copies:=1, Collate:=True
        End With
    End If
    Unload Me
End Sub

Cho mình hỏi nếu không vào cửa sổ preview mà vào cửa sổ print để chọn máy in thì phải thay đổi đoạn code này như thế nào?
mình cảm ơn!

Hong.Van · 16/12/12

Em đang chập chững với code mảng, ở đây có code này em còn chưa hiểu lắm xin vui lòng giải thích cặn kẻ giúp em
Dùng vòng lập lấy các số lẻ trong A1:A10 và chuyển sang cột C

Mã:

[COLOR=#0000BB][FONT=monospace]Sub Test[/FONT][/COLOR][COLOR=#007700][FONT=monospace]()
  [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Dim sArray[/FONT][/COLOR][COLOR=#007700][FONT=monospace], [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Arr[/FONT][/COLOR][COLOR=#007700][FONT=monospace](), [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]i [/FONT][/COLOR][COLOR=#007700][FONT=monospace]As [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Long[/FONT][/COLOR][COLOR=#007700][FONT=monospace], [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]j [/FONT][/COLOR][COLOR=#007700][FONT=monospace]As [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Long
  sArray [/FONT][/COLOR][COLOR=#007700][FONT=monospace]= [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Range[/FONT][/COLOR][COLOR=#007700][FONT=monospace]([/FONT][/COLOR][COLOR=#DD0000][FONT=monospace]"A1:A10"[/FONT][/COLOR][COLOR=#007700][FONT=monospace]).[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Value
  ReDim Arr[/FONT][/COLOR][COLOR=#007700][FONT=monospace]([/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]1 To UBound[/FONT][/COLOR][COLOR=#007700][FONT=monospace]([/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]sArray[/FONT][/COLOR][COLOR=#007700][FONT=monospace]), [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]1 To 1[/FONT][/COLOR][COLOR=#007700][FONT=monospace])
  For [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]i [/FONT][/COLOR][COLOR=#007700][FONT=monospace]= [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]1 To UBound[/FONT][/COLOR][COLOR=#007700][FONT=monospace]([/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]sArray[/FONT][/COLOR][COLOR=#007700][FONT=monospace])
    If [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]sArray[/FONT][/COLOR][COLOR=#007700][FONT=monospace]([/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]i[/FONT][/COLOR][COLOR=#007700][FONT=monospace], [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]1[/FONT][/COLOR][COLOR=#007700][FONT=monospace]) [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Mod 2 Then
       j [/FONT][/COLOR][COLOR=#007700][FONT=monospace]= [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]j [/FONT][/COLOR][COLOR=#007700][FONT=monospace]+ [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]1
      Arr[/FONT][/COLOR][COLOR=#007700][FONT=monospace]([/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]j[/FONT][/COLOR][COLOR=#007700][FONT=monospace], [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]1[/FONT][/COLOR][COLOR=#007700][FONT=monospace]) = [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]sArray[/FONT][/COLOR][COLOR=#007700][FONT=monospace]([/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]i[/FONT][/COLOR][COLOR=#007700][FONT=monospace], [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]1[/FONT][/COLOR][COLOR=#007700][FONT=monospace])
    [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]End [/FONT][/COLOR][COLOR=#007700][FONT=monospace]If
  [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Next
  Range[/FONT][/COLOR][COLOR=#007700][FONT=monospace]([/FONT][/COLOR][COLOR=#DD0000][FONT=monospace]"C1:C10"[/FONT][/COLOR][COLOR=#007700][FONT=monospace]) = [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Arr
End Sub [/FONT][/COLOR]

Em cảm ơn!

hoamattroicoi · 16/12/12

Hong.Van đã viết:
Em đang chập chững với code mảng, ở đây có code này em còn chưa hiểu lắm xin vui lòng giải thích cặn kẻ giúp em
Dùng vòng lập lấy các số lẻ trong A1:A10 và chuyển sang cột C

PHP:

Sub Test()
  Dim sArray, Arr(), i As Long, j As Long ' Khai bao bien
  
  sArray = Range("A1:A10").Value 'Nap du lieu vung A1 : A10 vao mang sArray
  
  ReDim Arr(1 To UBound(sArray), 1 To 1) 'Khai bao lai mang ket qua, mang Arr co so hang bang voi so hang cua mang sArray va co 1 cot, ban tim hieu xem ubound(sArray) xem no tra ve cai gi nhe? Dung Msgbox kiem tra nha.
  
  For i = 1 To UBound(sArray) ' Dung vong lap duyet qua cac phan tu cua sArray
    
    If sArray(i, 1) Mod 2 Then ' neu phan tu thu i cua sArray khong chia het cho 2 thi
       j = j + 1 ' tang bien j
      
      Arr(j, 1) = sArray(i, 1) ' Gan phan tu cua mang ket qua bang phan tu cua mang du lieu nguon ma tai do no k chia het cho 2
    
    End If
  
  Next
  
  Range("C1:C10") = Arr ' Do mang ket qua Arr ra vung C1 : C10 tren sheet

  ' Co the viet dong lenh tren thanh the nay [C1].Resize(j, 1) = Arr

End Sub

' Chu y nen khai bao ro rang la ban dang lam viec voi sheet nao trong Workbook nhe!!!

Hong.Van chỉnh 2 câu lệnh này cho hoàn chỉnh nhé :

sArray = Sheet1.Range("A1:A" & sheet1.[A65536].End(xlUp).Row).Value
Sheet1.[C1].Resize(j, 1) = Arr

thanhlanh · 16/12/12

Hong.Van đã viết:
Trước đây em có thấy bài của thành viên Siwtom , nhưng bây giờ tìm không ra!
Nhân đây cho em hỏi, các Thầy hoặc anh chị có code nào để sắp xếp lại code thụt ra , thụt vào không? em có tải File của tác giả Phan Ngoc Lan (!?) nhưng kg dùng được, Ai có cho em xin!
Em cảm ơn

Để thụt ra thụt vào, dùng tiện ích nhỏ gọn sau:
Nhưng chỉ có tác dụng với EXcel 2003 trở về trước.
Cách dùng: Giải nén, chạy File IndenterVBA.exe
Mở file Excel, vào trang VBE, bấm chuột phải vào nơi bất kỳ để viết code --> chọn Smart Indenter --> Có nhiều lụa chọn: Indenter thủ tục (đang đứng) hoặc Indenter module hoặc Indenter cả chương trình (tất cả module, sheet ...)

Hong.Van · 16/12/12

hoamattroicoi đã viết:

PHP:

Sub Test()
  Dim sArray, Arr(), i As Long, j As Long ' Khai bao bien
  
  sArray = Range("A1:A10").Value 'Nap du lieu vung A1 : A10 vao mang sArray
  
  ReDim Arr(1 To UBound(sArray), 1 To 1) 'Khai bao lai mang ket qua, mang Arr co so hang bang voi so hang cua mang sArray va co 1 cot, ban tim hieu xem ubound(sArray) xem no tra ve cai gi nhe? Dung Msgbox kiem tra nha.
  
  For i = 1 To UBound(sArray) ' Dung vong lap duyet qua cac phan tu cua sArray
    
    If sArray(i, 1) Mod 2 Then ' neu phan tu thu i cua sArray khong chia het cho 2 thi
       j = j + 1 ' tang bien j
      
      Arr(j, 1) = sArray(i, 1) ' Gan phan tu cua mang ket qua bang phan tu cua mang du lieu nguon ma tai do no k chia het cho 2
    
    End If
  
  Next
  
  Range("C1:C10") = Arr ' Do mang ket qua Arr ra vung C1 : C10 tren sheet

  ' Co the viet dong lenh tren thanh the nay [C1].Resize(j, 1) = Arr

End Sub

' Chu y nen khai bao ro rang la ban dang lam viec voi sheet nao trong Workbook nhe!!!

Hong.Van chỉnh 2 câu lệnh này cho hoàn chỉnh nhé :

sArray = Sheet1.Range("A1:A" & sheet1.[A65536].End(xlUp).Row).Value
Sheet1.[C1].Resize(j, 1) = Arr

Cảm ơn bạn nhiều
Các câu lệnh bổ sung của bạn giúp mình hiểu hơn, vì cần lưu ý số dòng của cột A & C
Mình cũng đang lò dò sang lĩnh vực viết code nên rất mong các Thầy cô & anh chị hỗ trợ & giúp đỡ
Đúng như tin đồn là bạn đang luyện code!
-------------

thanhlanh đã viết:
Để thụt ra thụt vào, dùng tiện ích nhỏ gọn sau:
Nhưng chỉ có tác dụng với EXcel 2003 trở về trước.
Cách dùng: Giải nén, chạy File IndenterVBA.exe
Mở file Excel, vào trang VBE, bấm chuột phải vào nơi bất kỳ để viết code --> chọn Smart Indenter --> Có nhiều lụa chọn: Indenter thủ tục (đang đứng) hoặc Indenter module hoặc Indenter cả chương trình (tất cả module, sheet ...)

Cảm ơn bạn, code chạy tốt, tiếc là kg chạy được trên Excel 2010

siwtom · 17/12/12

Nguyên văn bởi Hoàng Trọng Nghĩa
Có thể gõ tiếng Việt bằng font khác như VNI còn Unicode thì không thể gõ được. Vì vậy diễn đàn có rất nhiều bài dùng các hàm chuyển đổi font cho môi trường VBE.

Hong.Van đã viết:
Trước đây em có thấy bài của thành viên Siwtom , nhưng bây giờ tìm không ra!
Nhân đây cho em hỏi, các Thầy hoặc anh chị có code nào để sắp xếp lại code thụt ra , thụt vào không? em có tải File của tác giả Phan Ngoc Lan (!?) nhưng kg dùng được, Ai có cho em xin!
Em cảm ơn

Theo tôi đoạn bạn trích có 2 ý. Thứ nhất là nói về việc gõ trong VBE. Thứ hai là nói về các hàm chuyển đổi bảng mã.

Vậy nếu bạn muốn nói về ý nào thì nên viết rõ ra chứ.

Nếu nói về gõ trong VBE thì tôi dùng windows-1258: Tools --> Options --> thẻ Editor Format, mục Font --> chọn Times New Roman (vietnamese)
Nhưng tôi chỉ dùng vietnamese để gõ chú thích thôi. Vì chuỗi dùng trong code thì luôn có thể nhập unicode kiểu:

Mã:

text = “C" & ChrW(7897) & "ng H" & ChrW(242) & "a X" & ChrW(227) & " H" & ChrW(7897) & "i Ch" & ChrW(7911) & " Ngh" & ChrW(297) & "a Vi" & ChrW(7879) & "t Nam”

Tôi không bao giờ, và chắc chắn sẽ không bao giờ, dùng VNI hay TCVN3. Nếu có quan tâm thì cũng chỉ để "giải quyết hậu quả" do người khác gây ra. Đã có biết bao nhiêu người hỏi, và sẽ hỏi: "chuyển VNI sang unicode như thế nào?"

Tôi không và sẽ không bao giờ hiểu được lý do nào mà ở thế kỷ 21 người ta vẫn còn dùng VNI. Trước đây khi hđh chưa hỗ trợ đa ngôn ngữ thì VNI (bên cạnh windows-1258) là giải pháp. Nhưng cả bây giờ khi hđh hỗ trợ đa ngôn ngữ, unicode? Tai sao ta cứ phải làm khổ nhau như thế nhỉ? Tất nhiên chọn bảng mã nào là quyền của người viết nhưng nếu mọi người đều dùng unicode cả thì mọi chuyện đơn giản hơn rất nhiều.

siwtom · 17/12/12

Hoàng Trọng Nghĩa đã viết:
Tiện ích thì cũng tốt, nhưng theo tôi thì tôi có thói quen tự canh ( bằng phím Tab >> và Shift + Tab << ), khi làm như vậy mình dễ chỉnh sửa trong code hơn là mình làm một loạt rồi mới canh thụt ra thụt vào.

Khi viết tôi nhấn Tab cho từng dòng hoặc cứ viết xong thì chọn cả 1 cụm dòng rồi nhấn Tab

siwtom · 17/12/12

ptm0412 đã viết:
tất cả các bài của siwtom đều gõ unicode trong môi trường VBA, một số bài có câu ghi chú nên dùng font gì để gõ: Courier New (Vietnamese), bảng mã Unicode tổ hợp

Không phải Courier New.
Trong VBE tôi dùng Times New Roman (vietnamese). Khi gõ chú thích thì dùng bảng mã windows-1258 (vietnamse)

Cũng không phải unicode tổ hợp.

Do chú thích trong VBEc dùng windows-1258 nên khi cần copy code lên GPE thì trước tiên tôi dán đoạn cần copy vào WORD (trong WORD có code VBA viết để convert) rồi convert toàn bộ code có chứa cả chú thích dùng windows-1258 sang unicode dựng sẵn. Chính vì thế mà trong hầu hết các bài gửi lên GPE mà có chú thích thì "chú thích đọc được" chứ không là "đầu trâu mặt ngựa".

Good-Luck · 21/12/12

Hoàng Trọng Nghĩa đã viết:
Có thể gõ tiếng Việt bằng font khác như VNI còn Unicode thì không thể gõ được. Vì vậy diễn đàn có rất nhiều bài dùng các hàm chuyển đổi font cho môi trường VBE.

có cách gõ Unicode tiếng việt trực tiếp trong VBA rồi |||||

,

ndu96081631 · 21/12/12

Good-Luck đã viết:
có cách gõ Unicode tiếng việt trực tiếp trong VBA rồi ,

Chẳng hiểu đang nói cái gì nữa

Hoàng Trọng Nghĩa · 21/12/12

siwtom đã viết:
Khi viết tôi nhấn Tab cho từng dòng hoặc cứ viết xong thì chọn cả 1 cụm dòng rồi nhấn Tab

Dạ, cách viết của em thường thì mỗi dòng em sẽ mỗi thụt vô thụt ra, nhưng nếu làm biếng thì em sẽ để hết một thủ tục (thủ tục nội bộ nào đó như With ... End With, If ... End If, For ... Next, ...), chứ không bao giờ em có thói quen cứ enter cho đã rồi đến khi End Sub mới thụt ra thụt vào, em tự cảm thấy nó chẳng khoa học tí nào cả!

ptm0412 · 21/12/12

siwtom đã viết:
Không phải Courier New.
Trong VBE tôi dùng Times New Roman (vietnamese). Khi gõ chú thích thì dùng bảng mã windows-1258 (vietnamse)

Cũng không phải unicode tổ hợp.

Do chú thích trong VBEc dùng windows-1258 nên khi cần copy code lên GPE thì trước tiên tôi dán đoạn cần copy vào WORD (trong WORD có code VBA viết để convert) rồi convert toàn bộ code có chứa cả chú thích dùng windows-1258 sang unicode dựng sẵn. Chính vì thế mà trong hầu hết các bài gửi lên GPE mà có chú thích thì "chú thích đọc được" chứ không là "đầu trâu mặt ngựa".

Xin lỗi siwtom vì trích dẫn cách làm của siwtom không đúng.
Nhưng sự thực là tôi dùng Courier New (Vietnamese), bảng mã Unicode tổ hợp gõ trong cửa sổ VBA và đọc được. Và có lẽ chỉ đọc được tại cửa sổ VBA chứ copy lên GPE thì thua.

Thí nghiệm:

1. Courier New (Vietnamese), Unicode tổ hợp:
hôm nay laÌ ngaÌy tâòn thêì

2. Courier New (Vietnamese), Vietnamese local CP 1258
hôm nay là ngày tận thế

Và cả 2 cách đều có thể đưa lên Msgbox của Window. Ghi chú là tôi không đụng chạm gì vào hệ thống hiển thị của window 7

Hoàng Trọng Nghĩa · 21/12/12

Good-Luck đã viết:
có cách gõ Unicode tiếng việt trực tiếp trong VBA rồi ,

Trong file của bạn tôi chẳng biết bạn đang sử dụng font kiểu gì nữa!

1) Trong VBE bạn đã gõ bằng CP1258 (Unicode tổ hợp)

2) Khi dùng hàm =UniVND(20035)

Thì được một kết quả như thế này:

Mã:

Hai mýõi nghiÌn, không trãm ba mýõi nãm ðôÌng.

Theo bạn nó là như thế nào nhỉ?

Hoàng Trọng Nghĩa · 21/12/12

ptm0412 đã viết:
Xin lỗi siwtom vì trích dẫn cách làm của siwtom không đúng.
Nhưng sự thực là tôi dùng Courier New (Vietnamese), bảng mã Unicode tổ hợp gõ trong cửa sổ VBA và đọc được. Và có lẽ chỉ đọc được tại cửa sổ VBA chứ copy lên GPE thì thua.

Thí nghiệm:

1. Courier New (Vietnamese), Unicode tổ hợp:
hôm nay laÌ ngaÌy tâòn thêì

2. Courier New (Vietnamese), Vietnamese local CP 1258
hôm nay là ngày tận thế

Và cả 2 cách đều có thể đưa lên Msgbox của Window. Ghi chú là tôi không đụng chạm gì vào hệ thống hiển thị của window 7

Sao em cũng thử dùng như Sư phụ: 2. Courier New (Vietnamese), Vietnamese local CP 1258

Em muốn viết: "Tôi yêu cầu bạn thực hiện điều này để tôi còn tiếp tục làm việc"

Thì lại được kết quả như sau:

Tôi yêu câÌu baòn thýòc hiêòn ðiêÌu naÌy ðêÒ tôi coÌn tiêìp tuòc laÌm viêòc

ptm0412 · 21/12/12

Tôi gõ thấy bình thường, cả máy ở nhà và máy công ty.

Chỉ khác là máy công ty không sử dụng được msgbox. (Chẳng biết chỗ sửa)

Hoàng Trọng Nghĩa · 21/12/12

ptm0412 đã viết:
Tôi gõ thấy bình thường, cả máy ở nhà và máy công ty.

Chỉ khác là máy công ty không sử dụng được msgbox. (Chẳng biết chỗ sửa)

Phải chăng là do Hệ điều hành hoặc Version của Office? Em xài máy cơ quan với WinXP, Excel 2003.

Good-Luck · 21/12/12

Hoàng Trọng Nghĩa đã viết:
Phải chăng là do Hệ điều hành hoặc Version của Office? Em xài máy cơ quan với WinXP, Excel 2003.

mục đích nói là như thầy Tuấn

[GPECODE=vb]Sub TIENGVIET()
MsgBox "hôm nay là ngày tận thế, rất mừng là mọi người còn sống", vbOKOnly, "chúc mường"
End Sub
[/GPECODE]

sử dụng copy trong VBA sau đó paste lên bình thường "sử dung font : Times New Roman"

Hoàng Trọng Nghĩa đã viết:
"Tôi yêu cầu bạn thực hiện điều này để tôi còn tiếp tục làm việc"

Thì lại được kết quả như sau:

Tôi yêu câÌu baòn thýòc hiêòn ðiêÌu naÌy ðêÒ tôi coÌn tiêìp tuòc laÌm viêòc

sao máy em ko bị như anh nghĩa nói

siwtom · 22/12/12

ptm0412 đã viết:
Xin lỗi siwtom vì trích dẫn cách làm của siwtom không đúng.
Nhưng sự thực là tôi dùng Courier New (Vietnamese), bảng mã Unicode tổ hợp gõ trong cửa sổ VBA và đọc được. Và có lẽ chỉ đọc được tại cửa sổ VBA chứ copy lên GPE thì thua.

Thí nghiệm:

1. Courier New (Vietnamese), Unicode tổ hợp:
hôm nay laÌ ngaÌy tâòn thêì

2. Courier New (Vietnamese), Vietnamese local CP 1258
hôm nay là ngày tận thế

Và cả 2 cách đều có thể đưa lên Msgbox của Window. Ghi chú là tôi không đụng chạm gì vào hệ thống hiển thị của window 7

Không sao cả. Tôi chỉ muốn đính chính là tôi dùng Times New Roman vì đúng là tôi chỉ dùng Times, vì tôi thích Times. Tôi không hề khẳng định là phải dùng Times.
Và khi gõ trong VBE bằng Unikey thì chọn bảng mã Vietnamese locale cp 1258

nguyenthuy13388 · 27/12/12

coppy dữ liệu sang 1 sheet theo 1 điều kiện

Dear GPE
Em có 1 bài về code VBA mà không biết làm như thế nào( attach file). Em xin phép được post lên diễn đàn để sử lý giúp em với ạ
Em xin chân thành cảm ơn

Quang_Hải · 27/12/12

nguyenthuy13388 đã viết:
Dear GPE
Em có 1 bài về code VBA mà không biết làm như thế nào( attach file). Em xin phép được post lên diễn đàn để sử lý giúp em với ạ
Em xin chân thành cảm ơn

Bạn mô tả quá ít. Copy tất cả và dán nối vào sheet tương ứng, hay chỉ copy dòng có dữ liệu. Tốt nhât nên đưa dữ liệu thật vào và mô tả rõ thêm tí nữa. Copy rồi có xóa dư liệu trong sheet1 hay không?

nguyenthuy13388 · 27/12/12

quanghai1969 đã viết:
Bạn mô tả quá ít. Copy tất cả và dán nối vào sheet tương ứng, hay chỉ copy dòng có dữ liệu. Tốt nhât nên đưa dữ liệu thật vào và mô tả rõ thêm tí nữa. Copy rồi có xóa dư liệu trong sheet1 hay không?

coppy rồi dán sang sheets tương ứng ah. và không xóa sheets gốc bác ạh

nguyenthuy13388 · 27/12/12

file quản lý phương tiện

quanghai1969 đã viết:
Bạn mô tả quá ít. Copy tất cả và dán nối vào sheet tương ứng, hay chỉ copy dòng có dữ liệu. Tốt nhât nên đưa dữ liệu thật vào và mô tả rõ thêm tí nữa. Copy rồi có xóa dư liệu trong sheet1 hay không?

Theo yêu cầu của bác Em xin post file lên ah.
Em đang xây dựng file, em cũng không giỏi Excel lắm nên chắc file vẫn hơi rối,các pác thông cảm ah.

seishirou_sama · 28/12/12

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 tính toán cho ô a1 và a2 công thức ở ô b1 thì công thức sẽ tự động link xuống các ô b2, b3, b4 mà không cần kéo tay. Như ở file đính kèm ạ

xuan.nguyen82 · 28/12/12

seishirou_sama đã viết:
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 tính toán cho ô a1 và a2 công thức ở ô b1 thì công thức sẽ tự động link xuống các ô b2, b3, b4 mà không cần kéo tay. Như ở file đính kèm ạ

Bạn dùng code này nha: khi bạn gõ số tại cột A, B, thì kết quả tự động ra cột C, không cần kéo tay nữa. (mà bạn đang đặt công thức tại cột C mà)

Mã:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rw As Long
If Not Intersect(Target, [A:B]) Is Nothing Then
    If Target.Columns.Count = 1 Then
        If Target.Rows.Count = 1 Then
            Rw = Target.Row
            Cells(Rw, 3).FormulaR1C1 = Cells(Rw - 1, 3).FormulaR1C1
        End If
    End If
End If
End Sub

file đính kèm.

Quang_Hải · 28/12/12

xuan.nguyen82 đã viết:
Bạn dùng code này nha: khi bạn gõ số tại cột A, B, thì kết quả tự động ra cột C, không cần kéo tay nữa. (mà bạn đang đặt công thức tại cột C mà)

Mã:

Private Sub Worksheet_Change(ByVal Target As Range) Dim Rw As Long If Not Intersect(Target, [A:B]) Is Nothing Then If Target.Columns.Count = 1 Then If Target.Rows.Count = 1 Then Rw = Target.Row Cells(Rw, 3).FormulaR1C1 = Cells(Rw - 1, 3).FormulaR1C1 End If End If End If End Sub

file đính kèm.

Sửa code của chị XN lại xíu nha, tại đang thất nghiệp quá.

PHP:

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, [A:B]) Is Nothing Then
    If Target.Count = 1 Then [C1].Copy Cells(Target.Row, 3)
End If
End Sub

xuan.nguyen82 · 28/12/12

Nhưng cũng chợt nhận thấy, đấy là mình gõ các dòng liền nhau, và mình đặt ra tình huống là, khi gõ các dòng cách nhau và làm thế nào để công thức các dòng dưới sẽ giống như 1 ô công thức đầu tiên?

Mã:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rw As Long
    If Not Intersect(Target, [A:B]) Is Nothing Then
            If Target.Columns.Count = 1 Then
             If Target.Rows.Count = 1 Then
               Rw = Target.Row
                 Cells(Rw, 3).FormulaR1C1 = [C65000].End(xlUp).FormulaR1C1
        End If
            End If
              End If
End Sub

File đính kèm. Giả sử nhập vào cột A hoặc B của dòng bất kỳ, công thức sẽ giống như cột C1 (như trong file)

xuan.nguyen82 · 28/12/12

quanghai1969 đã viết:
Sửa code của chị XN lại xíu nha, tại đang thất nghiệp quá.

PHP:

Hihi. Em cảm ơn anh nhiều!

Anh yên tâm là không thất nghiệp đâu, còn nhiều câu hỏi chưa ai trả lời kìa.

thanhlanh · 28/12/12

Nếu người ta copy dữ liệu (nhiều hơn 1 ô) từ nơi khác đến thì ... tèo!

xuan.nguyen82 · 28/12/12

thanhlanh đã viết:
Nếu người ta copy dữ liệu (nhiều hơn 1 ô) từ nơi khác đến thì ... tèo!

Mỗi bài toán có nhiều tình huống khác nhau nên có lẽ chỉ đưa ra cái gần nhất với đề bài. Anh nhỉ?

(hic, sao em hoa mắt thế nàyyyyyyyyy)

thanhlanh · 28/12/12

xuan.nguyen82 đã viết:
Mỗi bài toán có nhiều tình huống khác nhau nên có lẽ chỉ đưa ra cái gần nhất với đề bài. Anh nhỉ?

(hic, sao em hoa mắt thế nàyyyyyyyyy)

Nhưng tình huống này chắc chắn sẽ xảy ra nên ta phải chuẩn bị sẵn ngay từ đầu, mình thấy XN khá lắm nên đây chỉ là chiện nhỏ, đúng không?

Còn nữa, hai câu này:
If Target.Columns.Count = 1 Then
If Target.Rows.Count = 1 Then

sao không thay bằng If Target.Count = 1 then ... cho khỏe

xuan.nguyen82 · 28/12/12

thanhlanh đã viết:
Nhưng tình huống này chắc chắn sẽ xảy ra nên ta phải chuẩn bị sẵn ngay từ đầu, mình thấy XN khá lắm nên đây chỉ là chiện nhỏ, đúng không?

Còn nữa, hai câu này:
If Target.Columns.Count = 1 Then
If Target.Rows.Count = 1 Then

sao không thay bằng If Target.Count = 1 then ... cho khỏe

Thú thật với anh là em mới học viết code mấy tháng nay, chứ trước kia chưa bao giờ em động đến code hay dùng code (lại còn nghĩ mình chẳng thể nào học được code) hic hic, quả thật là .....chậm tiến....trình độ em còn non và có những tình huống chưa lường trước hết được khi lỗi code hoặc các vấn đề khác trong 1 đề bài.

Có rất nhiều bài người khác giải vèo cái là xong, dễ òm...mà với em thì lâu lắc, mất thời gian hơn. hic hic.....

Good-Luck · 29/12/12

xuan.nguyen82 đã viết:
Mỗi bài toán có nhiều tình huống khác nhau nên có lẽ chỉ đưa ra cái gần nhất với đề bài. Anh nhỉ?

(hic, sao em hoa mắt thế nàyyyyyyyyy)

nếu chỉ làm theo tình huống trên thì microsoft đã free cho sẵn rồi, thì viết thêm code làm gì nữa cho mệt

Lê Duy Thương · 29/12/12

xuan.nguyen82 đã viết:
Thú thật với anh là em mới học viết code mấy tháng nay, chứ trước kia chưa bao giờ em động đến code hay dùng code (lại còn nghĩ mình chẳng thể nào học được code) hic hic, quả thật là .....chậm tiến....trình độ em còn non và có những tình huống chưa lường trước hết được khi lỗi code hoặc các vấn đề khác trong 1 đề bài.

Có rất nhiều bài người khác giải vèo cái là xong, dễ òm...mà với em thì lâu lắc, mất thời gian hơn. hic hic.....

lại thêm mooth người bước vào con đường đau khổ.chúc mừng nha. cố gắng đi

nguyenthuy13388 · 1/1/13

xuan.nguyen82 đã viết:
Hihi. Em cảm ơn anh nhiều!

Anh yên tâm là không thất nghiệp đâu, còn nhiều câu hỏi chưa ai trả lời kìa.

Like câu nói này của Anh.

nguyenthuy13388 · 1/1/13

xuan.nguyen82 đã viết:
Bạn dùng code này nha: khi bạn gõ số tại cột A, B, thì kết quả tự động ra cột C, không cần kéo tay nữa. (mà bạn đang đặt công thức tại cột C mà)

Mã:

Private Sub Worksheet_Change(ByVal Target As Range) Dim Rw As Long If Not Intersect(Target, [A:B]) Is Nothing Then If Target.Columns.Count = 1 Then If Target.Rows.Count = 1 Then Rw = Target.Row Cells(Rw, 3).FormulaR1C1 = Cells(Rw - 1, 3).FormulaR1C1 End If End If End If End Sub

file đính kèm.

bài này chỉ cần dùng bản ghi tự động của macro là được mà. đâu cần phải mệt óc nghĩ ra code làm gì??? không biết Em nói có đúng không ah?

seishirou_sama · 3/1/13

Cho em hỏi em đã copy code vào khung chạy macro của excel bằng cách nhấn ALT + F11 và copy vào nhưng sau đó em trở lại khung chat của excel và vẫn không thấy code chạy là sao vậy ạ

tvxdgt · 3/1/13

seishirou_sama đã viết:
Cho em hỏi em đã copy code vào khung chạy macro của excel bằng cách nhấn ALT + F11 và copy vào nhưng sau đó em trở lại khung chat của excel và vẫn không thấy code chạy là sao vậy ạ

Bạn nhấn ALT+F8 xuất hiện hộp thoại, click vào tên code vừa copy và bấm run là chạy liền à.

seishirou_sama · 3/1/13

Good-Luck đã viết:
nếu chỉ làm theo tình huống trên thì microsoft đã free cho sẵn rồi, thì viết thêm code làm gì nữa cho mệt

Vậy có cách nào không viết code mà vẫn làm như trên được không?

hungpecc1 · 4/1/13

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

Hoàng Trọng Nghĩa · 4/1/13

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

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.

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 (2 người xem)

Người dùng đang xem chủ đề này

Love Wingchun

Thành viên mới

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

Thành viên mới

Geotechnics

strive for mastery

strive for mastery

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

Thành viên mới

File đính kèm

Thành viên chính thức

Nothing & Nothing

Thành viên chính thức

Nothing & Nothing

Thành viên mới

Thành viên gạo cội

Thành viên tích cực

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

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

Thành viên gạo cội

Huyền thoại GPE

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

Thành viên tích cực

Huyền thoại GPE

Thành viên tích cực

File đính kèm

Thành viên tích cực

Huyền thoại GPE

Thành viên tích cực

Huyền thoại GPE

Thành viên tích cực

Huyền thoại GPE

Thành viên tích cực

Chuyên gia GPE

Huyền thoại GPE

Thành viên tích cực

Thành viên tích cực

Huyền thoại GPE

Thành viên hoạt động

File đính kèm

Thành viên tiêu biểu

Thành viên hoạt động

Thành viên gạo cội

File đính kèm

Thành viên mới

File đính kèm

Thành viên mới

Thành viên gạo cội

Thành viên mới

Thành viên mới

Thành viên mới

Thành viên gạo cội

Thành viên mới

Thành viên gạo cội

Thành viên hoạt động

Thành viên tích cực

Thành viên hoạt động

File đính kèm

Chuyên gia GPE

Thành viên hoạt động

File đính kèm

Chuyên gia GPE

Thành viên hoạt động

Thành viên tiêu biểu

Chuyên gia GPE

Busy

Chuyên gia GPE

Bad Excel Member

Thành viên hoạt động

Busy

Thành viên gắn bó

Thành viên tích cực

File đính kèm

Busy

Thành viên gắn bó

Thành viên gắn bó