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

Liên hệ QC
Status
Không mở trả lời sau này.

ST-Lu!

Love Wingchun
Tham gia
19/8/08
Bài viết
730
Được thích
546
Nghề nghiệp
Xích lô một thời
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
 
Chỉnh sửa lần cuối bởi điều hành viên:
Những số 7921, 273, 417 bác lấy như thế nào ạ??? chữ CHrW là như thế nào??
Các chữ tiếng việt khác thì sao ạ???
ChrW là hàm chuyển mã Ascii thành ký tự có hỗ trợ Unicode.
Chữ nào ứng với số bao nhiêu thì bạn xem trong file đính kèm.
 

File đính kèm

  • Bang ma Unicode.rar
    5.8 KB · Đọc: 18
Upvote 0
- Cách dùng: Bạn dùng bảng mã Unicode nhé
+ Tại một cell bạn gõ (ví dụ :A1 =Giải pháp excel thật tuyệt vời !")
+ Tại cell mới bạn gọi hàm trên :( A2 =UniVba(A1))
Người ta cần đặt tên sheet, nếu gõ vào cell A1 tên sheet, xong dùng hàm tham chiếu đến A1, lấy mã, xong gán vào code đặt tên sheet... Hic... vậy ta đặt tên sheet = Cell A1 cho rồi
PHP:
Sub doiten()
  Sheet1.Name = Sheet1.Range("A1").Value
End Sub
Khỏe hơn không?
 
Upvote 0
Người ta cần đặt tên sheet, nếu gõ vào cell A1 tên sheet, xong dùng hàm tham chiếu đến A1, lấy mã, xong gán vào code đặt tên sheet... Hic... vậy ta đặt tên sheet = Cell A1 cho rồi
PHP:
Sub doiten()
  Sheet1.Name = Sheet1.Range("A1").Value
End Sub
Khỏe hơn không?
Hiểu ý Sư phụ như đấy là thử nghiệm thôi mà.
 
Upvote 0
Nguyên văn bởi ndu
Người ta cần đặt tên sheet, nếu gõ vào cell A1 tên sheet, xong dùng hàm tham chiếu đến A1, lấy mã, xong gán vào code đặt tên sheet... Hic... vậy ta đặt tên sheet = Cell A1 cho rồi...
Khỏe hơn không?
Cách này khỏe ở chỗ khỏi phải chuyển đổi tốn khá nhiều thời gian, nhất là khi không có hàm hỗ trợ. Nhưng cách này có một chỗ bất tiện là phải tốn và bảo vệ một vùng trên sheet. Khỏe trước nhưng mệt sau. Không thể nói cách nào khỏe hơn. Có lẽ tùy vào trường hợp cụ thể mà ta dùng cho phù hợp.
 
Upvote 0
Giải thích giúp code chuyển data từ Access sang Excel

Tôi record macro việc chuyển dữ liệu từ Acces sang Excel được đoạn như sau:
PHP:
    With ActiveSheet.ListObjects.Add(SourceType:=0, _
    Source:=Array("OLEDB;Provider=Microsoft.ACE.OLEDB.12.0;" _
    , _
    "Data Source=D:\BinhThuan\CuocVc.mdb;Jet OLEDB:Global Bulk Transactions=1;" _
    , _
    "Jet OLEDB:Support Complex Data=False" _
    ), Destination:=Range("$A$1")).QueryTable       'Ten cua vung muon dua vao
        .CommandType = xlCmdTable                   'Can-thiet)
        .CommandText = Array("BinhThuan_CVC")       'Ten cua Table file acess
        .SourceDataFile = "D:\folder\abc.mdb"           ' path file access
        .Refresh BackgroundQuery:=False         ' Ko co dong nay khong co du lieu   (Can thiet)
    End With

Tôi chỉnh nó chút xíu, thành cái như sau:
PHP:
Function GetData_Access(N_WB_Dest As String, N_Sh_Dest As String, N_rng_Dest As String, N_Tb_Access As String, Path_DataSource As String)
    Path_DataSource = Path_DataSource.Address
    With Workbooks(N_WB_Dest).Sheets(Name_Sh_Dest).ListObjects.Add(SourceType:=0, Source:=Array("OLEDB;Provider=Microsoft.ACE.OLEDB.12.0;" _
    , _
    "Data Source= Path_DataSource ;Jet OLEDB:Global Bulk Transactions=1;" _
    , _
    "Jet OLEDB:Support Complex Data=False" _
    ), Destination:=Range(N_rng_Dest)).QueryTable
        .CommandType = xlCmdTable
        .CommandText = Array(N_Tb_Access)
        .SourceDataFile = Path_DataSource
        .Refresh BackgroundQuery:=False
    End With
End Function

Nếu đưa như sau thì không bị lỗi:
PHP:
"Data Source=D:\folder\abc.mdb;Jet OLEDB:Global Bulk Transactions=1;" _

nhưng nếu như vầy thì báo lỗi:
PHP:
"Data Source="D:\folder\abc.mdb";Jet OLEDB:Global Bulk Transactions=1;" _
Làm sao để biến Path_DataSource = D:\folder\abc.mdb chứ không phải "D:\folder\abc.mdb"
Rỏ ràng 2 cái khác nhau ở chổ có dấu nháy.

Nhờ mọi người đóng góp.
 
Lần chỉnh sửa cuối:
Upvote 0
Tôi record macro việc chuyển dữ liệu từ Acces sang Excel được đoạn như sau:
PHP:
    With ActiveSheet.ListObjects.Add(SourceType:=0, _
    Source:=Array("OLEDB;Provider=Microsoft.ACE.OLEDB.12.0;" _
    , _
    "Data Source=D:\BinhThuan\CuocVc.mdb;Jet OLEDB:Global Bulk Transactions=1;" _
    , _
    "Jet OLEDB:Support Complex Data=False" _
    ), Destination:=Range("$A$1")).QueryTable       'Ten cua vung muon dua vao
        .CommandType = xlCmdTable                   'Can-thiet)
        .CommandText = Array("BinhThuan_CVC")       'Ten cua Table file acess
        .SourceDataFile = "D:\folder\abc.mdb"           ' path file access
        .Refresh BackgroundQuery:=False         ' Ko co dong nay khong co du lieu   (Can thiet)
    End With

Tôi chỉnh nó chút xíu, thành cái như sau:
PHP:
Function GetData_Access(N_WB_Dest As String, N_Sh_Dest As String, N_rng_Dest As String, N_Tb_Access As String, Path_DataSource As String)
    Path_DataSource = Path_DataSource.Address
    With Workbooks(N_WB_Dest).Sheets(Name_Sh_Dest).ListObjects.Add(SourceType:=0, Source:=Array("OLEDB;Provider=Microsoft.ACE.OLEDB.12.0;" _
    , _
    "Data Source= Path_DataSource ;Jet OLEDB:Global Bulk Transactions=1;" _
    , _
    "Jet OLEDB:Support Complex Data=False" _
    ), Destination:=Range(N_rng_Dest)).QueryTable
        .CommandType = xlCmdTable
        .CommandText = Array(N_Tb_Access)
        .SourceDataFile = Path_DataSource
        .Refresh BackgroundQuery:=False
    End With
End Function

Nếu đưa như sau thì không bị lỗi:
PHP:
"Data Source=D:\folder\abc.mdb;Jet OLEDB:Global Bulk Transactions=1;" _

nhưng nếu như vầy thì báo lỗi:
PHP:
"Data Source="D:\folder\abc.mdb";Jet OLEDB:Global Bulk Transactions=1;" _
Làm sao để biến Path_DataSource = D:\folder\abc.mdb chứ không phải "D:\folder\abc.mdb"
Rỏ ràng 2 cái khác nhau ở chổ có dấu nháy.

Nhờ mọi người đóng góp.
Sửa thành vầy thử xem:
Mã:
"Data Source= " & Path_DataSource & ";Jet OLEDB:Global Bulk Transactions=1;"
Tiếc là tôi không có file nên không thử nghiệm được
 
Upvote 0
Sửa thành vầy thử xem:
Mã:
"Data Source= " & Path_DataSource & ";Jet OLEDB:Global Bulk Transactions=1;"
Tiếc là tôi không có file nên không thử nghiệm được
Vậy tôi gửi Anh NDU và mọi người xem thử nhé.

Cái đường dẫn anh chỉnh lại cho phù hợp nhé.

Thân.
 

File đính kèm

  • CuocVC1.xls
    77.5 KB · Đọc: 9
  • CuocVc.rar
    10.6 KB · Đọc: 14
Upvote 0
Vậy tôi gửi Anh NDU và mọi người xem thử nhé.

Cái đường dẫn anh chỉnh lại cho phù hợp nhé.

Thân.
Thử sửa vầy xem:
PHP:
Sub GetData_Access(N_Sh_Dest As String, N_rng_Dest As String, N_Tb_Access As String, Path_DataSource As String)
    With Sheets(N_Sh_Dest).ListObjects.Add(SourceType:=0, Source:=Array("OLEDB;Provider=Microsoft.ACE.OLEDB.12.0;" _
    , _
    "Data Source=" & Path_DataSource & ";Jet OLEDB:Global Bulk Transactions=1;" _
    , _
    "Jet OLEDB:Support Complex Data=False" _
    ), Destination:=Range(N_rng_Dest)).QueryTable
        .CommandType = xlCmdTable
        .CommandText = Array(N_Tb_Access)
        .SourceDataFile = Path_DataSource
        .Refresh BackgroundQuery:=False
    End With
End Sub
PHP:
Sub Macro3()
    Dim wb As String
    Dim sh As String, rng As String
    Dim path_ac As String, TB_Ac As String
    sh = "Sheet3"
    rng = "$A$1"
    TB_Ac = "BinhThuan_CVC"
    path_ac = "C:\Documents and Settings\TUANNA.MAINTENANCE\Desktop\CuocVc.mdb"  ' Soure Patch
    Sheets(sh).Activate
    GetData_Access sh, rng, TB_Ac, path_ac
End Sub
Tôi thấy không cần biến Wb, vì đàng nào ta cũng đang chạy code tại file hiện hành mà
 
Upvote 0
Cảm ơn anh NDU
Tôi đã làm được. Mong học hỏi nhiều.
Thân
 
Upvote 0
Nhờ các anh chị giải quyết hộ em lỗi Runtime error '9' trong đoạn code dưới đây với.

Code của Anh Thắng viết cho em để tìm phần tử trùng của nhiều mảng có điều kiện.


Sub GPE()
Dim Cll As Range, FCll As Range, iCll As Range, FirstRow As Long, Arr(), i As Long, rc As Integer, kCll As Range
Result.[C6:AC65536].ClearContents
rc = Data.[C2].CurrentRegion.Rows.Count
Set kCll = Data.Cells(2, 3).Resize(rc - 3, 27)
For Each Cll In Result.[C2:AC2]
Set FCll = kCll.Find(Cll.Value, Data.[C2], xlValues, 1)
If FCll Is Nothing Then GoTo NextCll
FirstRow = FCll.Row
i = 0
Do
Set FCll = kCll.FindNext(FCll)
If WorksheetFunction.CountIf(Data.Cells(FCll.Row + 1, 3).Resize(, 27), Cll.Offset(1)) > 0 Then
i = i + 1
ReDim Preserve Arr(1 To i)
Arr(i) = FCll.Row + 2
End If
Loop Until FCll.Row = FirstRow

For Each iCll In Data.Cells(Arr(1), 3).Resize(3, 27)
For i = 2 To UBound(Arr)
If Data.Cells(Arr(i), 3).Resize(3, 27).Find(What:=iCll.Value, LookAt:=xlWhole) Is Nothing Then
GoTo NextiCll
End If
Next
Result.Cells(65536, Cll.Column).End(xlUp).Offset(1).Value = iCll.Value
NextiCll:
Next
NextCll:
Next
End Sub


Chạy bị báo lỗi "Subcript out of range" tại dòng:

For Each iCll In Data.Cells(Arr(1), 3).Resize(3, 27)
 

File đính kèm

  • GPE.rar
    24 KB · Đọc: 16
Lần chỉnh sửa cuối:
Upvote 0
Nhờ các anh chị giải quyết hộ em lỗi Runtime error '9' trong đoạn code dưới đây với.

Code của Anh Thắng viết cho em để tìm phần tử trùng của nhiều mảng có điều kiện.

Chạy bị báo lỗi "Subcript out of range" tại dòng:

For Each iCll In Data.Cells(Arr(1), 3).Resize(3, 27)

Bạn thử thêm On Error Resume Next xem sao!
 
Upvote 0
em gửi file đính kèm , mong các anh chị giúp đỡ

Sub test()
Dim rng As Range, lrow As Long, i As Long
Sheet2.Range("a7:k10000").Clear
Set rng = Sheet1.Range(Sheet1.[K6], Sheet1.[K7].End(xlDown)).Offset(, -10).Resize(, 11)
lrow = 6
For i = 1 To 3
With rng
.AutoFilter
.AutoFilter 11, [a5].Value
.SpecialCells(xlCellTypeVisible).Copy Sheet2.Cells(lrow + 1, 1)
.AutoFilter
End With
lrow = Sheet2.Range("D65000").End(xlUp).Row
Set rng = rng.Resize(1).Offset(rng.Rows.Count)
lrow = Sheet2.Range("D65000").End(xlUp).Row
Set rng = Sheet1.Range(Sheet1.Cells(rng.Row, 11), Sheet1.Cells(rng.Row + 1, 11).End(xlDown)).Offset(, -10).Resize(, 11)
Next i
Sheet1.[d65000].End(xlUp).Offset(-1, -3).Resize(10, 11).Copy Sheet2.Cells(lrow + 1, 1)
End Sub

để em có thể vận dụng linh hoạt code này
 

File đính kèm

  • Bang THCPCT1.xls
    49 KB · Đọc: 14
Upvote 0
/-(ình như bạn cần lọc 3 vùng của trang 1 sang trang 2

Nhưng muốn công thức cọng luôn đúng bạn nên làm vầy:

(*) Ở trang tính 2 ta thiết lập 3 vùng cố định, mình giả dụ vùng 1 từ dòng 8 đến 46
V2 từ D48 đến 67 & V3 từ D69 cho tới 95 & dưới liền kề dòng 95 là dòng tổng cọng;

(*) Ta copy dữ liệu lên dòng đầu của 3 vùng đó

(*) Sau đó 3 vùng không chứa dữ liệu sẽ được code cho ẩn đi.

Làm cách này dịnh dạng các tổng con & tổng cọng vũ như cẩn;

(Các con số 46,67 & 95 là mình án chừng, còn bạn thì fải cụ thể & do thực tiển đem lại)

Chắc bạn sẽ thực hiện được tự ên & chúc thành công!

/(/ếu khó khăn bạn tham khảo macro sau:

PHP:
Option Explicit
Sub test()
 Dim Rng As Range, lRow As Long, jJ As Long, Sh As Worksheet, dRng As Range
 Dim DgD As Long, DgC As Long

Set Sh = ThisWorkbook.Worksheets("Sheet1")
Union(Range("A8:A46").Resize(, 12), Range("A48:A67").Resize(, 12), _
   Range("A69:A95").Resize(, 12)).ClearContents
DgD = 7
For jJ = 1 To 3
   DgC = Sh.Cells(DgD, 11).End(xlDown).Row
   Set Rng = Sh.Range(Sh.Cells(DgD, "A"), Sh.Cells(DgC, "K"))
   
    With Rng
      .AutoFilter
      .AutoFilter 11, [a5].Value
      lRow = Choose(jJ, 8, 48, 69)
      .SpecialCells(xlCellTypeVisible).Copy Sheet2.Cells(lRow, "A")
      .AutoFilter
    End With   
   DgD = DgC + 2
 Next jJ
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
Ở sheet 2 em nên sửa đoạn mã này ntn??
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$A$5" Then Call test
End Sub

Em thấy báo lỗi : Call test
dòng đầu của đoạn mã màu vàng

Và hộp thoại:
Compile error
Am biguous name detected : test
 
Lần chỉnh sửa cuối:
Upvote 0
Nhưng muốn công thức cọng luôn đúng bạn nên làm vầy:

(*) Ở trang tính 2 ta thiết lập 3 vùng cố định, mình giả dụ vùng 1 từ dòng 8 đến 46
V2 từ D48 đến 67 & V3 từ D69 cho tới 95 & dưới liền kề dòng 95 là dòng tổng cọng;

(*) Ta copy dữ liệu lên dòng đầu của 3 vùng đó

(*) Sau đó 3 vùng không chứa dữ liệu sẽ được code cho ẩn đi.

Làm cách này dịnh dạng các tổng con & tổng cọng vũ như cẩn;

(Các con số 46,67 & 95 là mình án chừng, còn bạn thì fải cụ thể & do thực tiển đem lại)

Chắc bạn sẽ thực hiện được tự ên & chúc thành công!

/(/ếu khó khăn bạn tham khảo macro sau:

PHP:
Option Explicit
Sub test()
 Dim Rng As Range, lRow As Long, jJ As Long, Sh As Worksheet, dRng As Range
 Dim DgD As Long, DgC As Long

Set Sh = ThisWorkbook.Worksheets("Sheet1")
Union(Range("A8:A46").Resize(, 12), Range("A48:A67").Resize(, 12), _
   Range("A69:A95").Resize(, 12)).ClearContents
DgD = 7
For jJ = 1 To 3
   DgC = Sh.Cells(DgD, 11).End(xlDown).Row
   Set Rng = Sh.Range(Sh.Cells(DgD, "A"), Sh.Cells(DgC, "K"))
   
    With Rng
      .AutoFilter
      .AutoFilter 11, [a5].Value
      lRow = Choose(jJ, 8, 48, 69)
      .SpecialCells(xlCellTypeVisible).Copy Sheet2.Cells(lRow, "A")
      .AutoFilter
    End With   
   DgD = DgC + 2
 Next jJ
End Sub

Anh ơi, anh làm cụ thể ở file em gửi cho anh đi, em thấy rất tốt rùi nhưng có 1 chút vướng mắc
Như code của anh, với mã khách đầu tiên ở sheet 2 thì ok, nhưng bắt đầu chọn mã khách tiếp theo thì dòng đầu của mã khách đầu tiên vẫn còn, khiến cho dữ liệu bị sai
 
Upvote 0
Bạn xen trong file kèm theo
 

File đính kèm

  • gpeVatTu.rar
    20.9 KB · Đọc: 14
Upvote 0
Tôi muốn ẩn dòng có điều kiện, nhưng khi lòng điều khiển vòng lặp thì nó không thực hiện được, như đoạn code sau, nhờ các bác chỉ giúp. Xin cảm ơn nhiều.

PHP:
Sub dk()
Dim i As Integer
Dim j As Integer
i = 1
j = i + 1
Do
If Range("A1").Offset(i, 0) = 0 Then 
 Range("j:10").EntireRow.Hidden = True
End If
i = i + 1
Loop Until IsEmpty(Range("A1").Offset(i, 0))
End Sub
 

File đính kèm

  • Book3.rar
    11.1 KB · Đọc: 14
Lần chỉnh sửa cuối:
Upvote 0
Tôi muốn ẩn dòng có điều kiện, nhưng khi lòng điều khiển vòng lặp thì nó không thực hiện được, như đoạn code sau, nhờ các bác chỉ giúp. Xin cảm ơn nhiều.

PHP:
Sub dk()
Dim i As Integer
Dim j As Integer
i = 1
j = i + 1
Do
If Range("A1").Offset(i, 0) = 0 Then 
 Range("j:10").EntireRow.Hidden = True
End If
i = i + 1
Loop Until IsEmpty(Range("A1").Offset(i, 0))
End Sub
Cụ thể điều kiện để ẩn dòng của bạn là gì?
(Xem sơ qua thì đoán code sai chổ Range("j:10")
 
Upvote 0
Cụ thể điều kiện để ẩn dòng của bạn là gì?
(Xem sơ qua thì đoán code sai chổ Range("j:10")
Cụ thể điều kiện là: Nếu A2 <>0 thì kiểm tra điều kiện A3, A3<>0 thì kiểm tra điều kiện A4, A4 = 0 thì ẩn dòng từ A4 đến A10. Còn nếu A4 <>0 thì kiểm tra tiếp tục đến A10.
 
Upvote 0
Cụ thể điều kiện là: Nếu A2 <>0 thì kiểm tra điều kiện A3, A3<>0 thì kiểm tra điều kiện A4, A4 = 0 thì ẩn dòng từ A4 đến A10. Còn nếu A4 <>0 thì kiểm tra tiếp tục đến A10.
Nói lại 1 lần nữa xem đúng ý bạn không nha: Kiểm tra từ A1 đến A10, cell nào rổng thì ẩn nguyên dòng. Đúng chứ?
Nếu đúng thế thì code quá đơn giản:
PHP:
Sub dk()
  Dim i As Long
  For i = 1 To 10
    Cells(i, 1).EntireRow.Hidden = IsEmpty(Cells(i, 1))
  Next
End Sub
 
Upvote 0
Status
Không mở trả lời sau này.
Web KT

Bài viết mới nhất

Back
Top Bottom