Chuyên mục xử lý, gỡ rối code VBA (1 người xem)

Liên hệ QC

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

Đang trực tuyến: 1 (Thành viên: 0, Khách: 1)
Status
Không mở trả lời sau này.
ndu96081631

ndu96081631

Huyền thoại GPE
Thành viên BQT
Super Moderator
Tham gia
5/6/08
Bài viết
30,703
Được thích
53,957
Sắp xếp theo thời gian sắp xếp theo bầu chọn
mhieuit đã viết:
Dear GPE,
em có đoạn code như bên dưói nhưng run không được, anh chị help check code sai chổ nào. thanks all.
Mã: 
Option Explicit
Private Sub test()
Dim i As Integer
        For i = 1 To Sheets.Count
            Sheets(i).Range([A16], [A65536].End(xlUp)).Resize(, 24).RowHeight = 25
        Next i
End Sub
Nhấp chuột vào đây để mở rộng...
PHP: 
Option Explicit
Private Sub test()
Dim i As Integer
        For i = 1 To Sheets.Count
            Sheets(i).Range("A16", Sheets(i).[A65536].End(xlUp)).Resize(, 24).RowHeight = 25
        Next i
End Sub
bạn sửa thế này
 
Upvote 0
comet_1701 đã viết:
PHP: 
Option Explicit
Private Sub test()
Dim i As Integer
        For i = 1 To Sheets.Count
            Sheets(i).Range("A16", Sheets(i).[A65536].End(xlUp)).Resize(, 24).RowHeight = 25
        Next i
End Sub
bạn sửa thế này
Nhấp chuột vào đây để mở rộng...

Đặt chiều cao dòng thì đâu cần Resize() làm gì?
Chỉ cần thế này:
PHP: 
Sheets(i).Range("A16", Sheets(i).[A65536].End(xlUp)).RowHeight = 25
Hoặc:
PHP: 
Sheets(i).Rows("16:" & Sheets(i).[A65536].End(xlUp).Row).RowHeight = 25
 
Upvote 0
Dear GPE,
code bên dưới có thể dùng For Each được không ạ?
PHP: 
Dim i As Integer
For i = 1 To Sheets.Count
      Sheets(i).Columns("C:D").EntireColumn.Hidden = True   
      Sheets(i).Columns("Q:R").EntireColumn.Hidden = True   
      Sheets(i).Columns("T").ColumnWidth = 10
      Sheets(i).Columns("W").ColumnWidth = 10
Next i

Và code dưới đây có cách nào viết gọn không ạ?
PHP: 
With Sheets(i).PageSetup            
   .Zoom = 95            
   .RightHeader = "Page &P of &N"           
   .PrintTitleRows = "$1:$15"            
   .LeftMargin = Application.InchesToPoints(0.5)            
   .RightMargin = Application.InchesToPoints(0.1)           
   .TopMargin = Application.InchesToPoints(0.1)            
   .BottomMargin = Application.InchesToPoints(0.1)        
End With

Thank all.
 
Upvote 0
mhieuit đã viết:
Dear GPE,
code bên dưới có thể dùng For Each được không ạ?
PHP: 
Dim i As Integer
For i = 1 To Sheets.Count
      Sheets(i).Columns("C:D").EntireColumn.Hidden = True   
      Sheets(i).Columns("Q:R").EntireColumn.Hidden = True   
      Sheets(i).Columns("T").ColumnWidth = 10
      Sheets(i).Columns("W").ColumnWidth = 10
Next i

Và code dưới đây có cách nào viết gọn không ạ?
PHP: 
With Sheets(i).PageSetup            
   .Zoom = 95            
   .RightHeader = "Page &P of &N"           
   .PrintTitleRows = "$1:$15"            
   .LeftMargin = Application.InchesToPoints(0.5)            
   .RightMargin = Application.InchesToPoints(0.1)           
   .TopMargin = Application.InchesToPoints(0.1)            
   .BottomMargin = Application.InchesToPoints(0.1)        
End With

Thank all.
Nhấp chuột vào đây để mở rộng...
PHP: 
Sub test()
Dim Ws As Worksheet, i As Long
For Each Ws In Worksheets
      Ws.Columns("C:D").EntireColumn.Hidden = True
      Ws.Columns("Q:R").EntireColumn.Hidden = True
      Ws.Columns("T").ColumnWidth = 10
      Ws.Columns("W").ColumnWidth = 10
Next
End Sub
For each thì thế này
 
Upvote 0
comet_1701 đã viết:
PHP: 
Sub test()
Dim Ws As Worksheet, i As Long
For Each Ws In Worksheets
      Ws.Columns("C:D").EntireColumn.Hidden = True
      Ws.Columns("Q:R").EntireColumn.Hidden = True
      Ws.Columns("T").ColumnWidth = 10
      Ws.Columns("W").ColumnWidth = 10
Next
End Sub
For each thì thế này
Nhấp chuột vào đây để mở rộng...
dear anh,
còn biến i em không thấy có trong đoạn code. check lại giúp em nhé
 
Upvote 0
mhieuit đã viết:
dear anh,
còn biến i em không thấy có trong đoạn code. check lại giúp em nhé
Nhấp chuột vào đây để mở rộng...
Ngộ quá! Biến khai báo mà không xài thì bỏ, đưa vào chỗ nào được mà check?
Hay là bắt buộc phải đưa vào như vầy:
PHP: 
Sub test()
Dim Ws As Worksheet, i As Long
For Each Ws In Worksheets
      i= i + 10     'Híc !'
      Ws.Columns("C:D").EntireColumn.Hidden = True
      Ws.Columns("Q:R").EntireColumn.Hidden = True
      Ws.Columns("T").ColumnWidth = 10
      Ws.Columns("W").ColumnWidth = 10
Next
i=0     'Hu hu'
End Sub

Muốn kiểu khác thì thử như vầy:
PHP: 
Sub test()
Dim Ws As Worksheet
For Each Ws In Worksheets
      Ws.Range("C:D, Q:R").EntireColumn.Hidden = True
      Ws.Range("T:T,W:W ").ColumnWidth = 10
Next
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
Ba Tê đã viết:
Ngộ quá! Biến khai báo mà không xài thì bỏ, đưa vào chỗ nào được mà check?
Hay là bắt buộc phải đưa vào như vầy:
PHP: 
Sub test()
Dim Ws As Worksheet, i As Long
For Each Ws In Worksheets
      i= i + 10     'Híc !'
      Ws.Columns("C:D").EntireColumn.Hidden = True
      Ws.Columns("Q:R").EntireColumn.Hidden = True
      Ws.Columns("T").ColumnWidth = 10
      Ws.Columns("W").ColumnWidth = 10
Next
i=0     'Hu hu'
End Sub

Muốn kiểu khác thì thử như vầy:
PHP: 
Sub test()
Dim Ws As Worksheet
For Each Ws In Worksheets
      Ws.Range("C:D, Q:R").EntireColumn.Hidden = True
      Ws.Range("T:T,W:W ").ColumnWidth = 10
Next
End Sub
Nhấp chuột vào đây để mở rộng...

Dear anh,
em xin lỗi vi em nói không rõ ý ạ,
ý em thế này, vì code của em duyệt qua từng sheet nên em khai báo biến i (sheets(i)), các sheets của em có hình thức giống nhau ạ. anh xem lại giúp em nếu bỏ biến i vậy code có duyệt qua các sheets không anh.
 
Upvote 0
mhieuit đã viết:
Dear anh,
em xin lỗi vi em nói không rõ ý ạ,
ý em thế này, vì code của em duyệt qua từng sheet nên em khai báo biến i (sheets(i)), các sheets của em có hình thức giống nhau ạ. anh xem lại giúp em nếu bỏ biến i vậy code có duyệt qua các sheets không anh.
Nhấp chuột vào đây để mở rộng...

Cứ cho code chạy thử, kết quả như thế nào, có đúng ý không, có chỗ nào chưa đúng... rồi tự nhận xét thôi.
Không cần biến i, 100 sheet nó cũng "quất" tuốt.
 
Upvote 0
Sử dụng with...end with.
Chào mọi người, em muốn hỏi: Có cách nào thực hiện được việc khi đang ở sheet2 mà sử dụng With ... End with để chọn toàn bộ cells của sheet1 không? Em cảm ơn.
 
Upvote 0
Xin mọi người giải thích cho mình về 2 dòng code sau với:

PHP: 
Range("SPValues").Columns.Hidden = False       
 Range(Range("SFStart").Offset(1, 0), Range("SFStart").Offset(1, 6).End(xlDown)).ClearContents
 
Upvote 0
hikaru0110 đã viết:
PHP: 
Range("SPValues").Columns.Hidden = False       
 Range(Range("SFStart").Offset(1, 0), Range("SFStart").Offset(1, 6).End(xlDown)).ClearContents
Nhấp chuột vào đây để mở rộng...
xóa dữ liệu
lấy vùng có tên SFStart
di chuyển xuống 1 dòng qua 6 cột vùng SFStart làm mốc
sau đó chọn từ dòng hiện tại đến dòng cuối cùng có dữ liệu, sau đó xóa dữ liều
 
Upvote 0
Nhờ các bác giúp dùm em đoạn code này , do code viết từ tiếng trung nên khi qua gởi qua việt nam , nó lỗi code tùm lum hết. Các bác có thể giải thích code này dùm em vì em không rành lắm.

Option Explicit
Private Sub CommandButton1_Click()
Dim ans As Variant
Dim Sh As Variant

ans = MsgBox("?涓单编号?？", vbYesNo, "")
If ans = vbNo Then Exit Sub
For Each Sh In Worksheets
Sh.Cells(3, 8) = Cells(2, 8) & Mid(Year(Date), 3, 2) & Application.Text(Month(Date), "00") & Application.Text(Day(Date), "00") & Application.Text(Hour(Time), "00") & Application.Text(Minute(Time), "00") & Application.Text(Second(Time), "00")
Next Sh
End Sub

Private Sub CommandButton2_Click()
Dim ans As Variant
Dim ┑LS As Variant
ans = MsgBox("保存当前生产┑ヂ?？", vbYesNo, "NKV CO.LTD")
If ans = vbNo Then Exit Sub
Application.ScreenUpdating = False
Application.DisplayAlerts = False
┑LS = ActiveWorkbook.Path & "\" & Cells(7, 8) & Cells(5, 2) & Cells(9, 2) & "_" & Cells(3, 8) & "_最?生产┑?xls"
Sheets("最?生产┑?).Copy
ActiveWorkbook.SaveAs Filename:=┑LS, FileFormat:=xlNormal, CreateBackup:=False
ActiveWorkbook.Close
MsgBox Cells(7, 8) & Cells(5, 2) & "_" & Cells(3, 8) & Cells(9, 2) & "_最?生产┑?xls?丫"保存", , "NKV CO.LTD"
End Sub
 
Upvote 0

File đính kèm

  • image.jpg
    image.jpg
    71.4 KB · Đọc: 50
Lần chỉnh sửa cuối:
Upvote 0
Các anh chị giúp em đoạn mã sau:
ActiveCell.FormulaR1C1 = _
"=""Tên khách hàng: ""&dulieu!R[-5]C[41]&""& M&""&ChrW(227)&"" khách hàng: ""&dulieu!R[-5]C[42]"
Do trong VBA không thể hiện tiếng việt nên em viết "Mã khách hàng" chèn vào đoạn mã trên.
Tuy nhiên, máy báo lỗi không chạy được.
 
Upvote 0
Upvote 0
Em có sử dụng code như sau:
Public Function CotName(i)
Alphabet = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
If Int((i - 1) / 26) = 0 Then
Chu1 = ""
Else
Chu1 = Mid(Alphabet, Int((i - 1) / 26), 1)
End If
If i Mod 26 = 0 Then
Chu2 = "Z"
Else
Chu2 = Mid(Alphabet, i Mod 26, 1)
End If
CotName = Chu1 & Chu2
End Function


Function msit80_kiemtra()
Range("A1").Select
socot = Range("A1").End(xlToRight).Column
For BienA = 1 To socot
Tencot = CotName(BienA)
Select Case Range(Tencot & "1").value
Case "brcd", "custseq", "custnm", "apprseq", "apprdt", "apprmatdt", "ccy", "appramt", "dsbsseq", "dsbsdt", "dsbsmatdt", "sprd", "sprdpst", "dsbsamt", "dsbsccy", "rpmtamt", "intamt", "dsbsbal", "dsbsamt2", "rpmtamt2", "intamt2", "subunit", "custstscd", "custtpcd", "custtpnm", "custdtltpcd", "custdtltpnm", "ecomist", "ecomistnm", "taxtpcdloc", "taxtpcdlocnm", "ofcno", "ofcnm", "pstintamt", "pstintamt2", "buscd", "lntpcd", "lnsbtpcd", "lstrpmtdt", "lstintchrgprd", "nxtrpmtschddt", "nxtintschddt", "exmtintamt", "exmtintamt2", "finainsttpcd", "finainsttpcdnm", "sicdloc", "province", "provincenm", "district", "districtnm", "zipcd", "addr1", "secured", "fndrstpcd", "fndrsnm", "exemptint", "exemptinttype", "fndprpstpcd", "fndprpstpcd_code", "intrpmtamt", "AQCCDFIN", "intrpmtamt2", "commcd", "commmn", "grpno", "trctcd", "trctnm", "BSNSSCLTPCD", "usrid", "usrnm", "acramt", "lceqa", "yrdays", "intcmth", "intrpymth", "inttrmmth", "remark"
Case Else
Msg ("Zero MSIT80 !!!!!")
Exit Function
End Select
Next
Msg ("Good" & vbCrLf & "Good" & vbCrLf & "Good")
End Function

Em muốn biết có cách nào phải so sánh từ A1, B1, C1, ... với tuần tự dãy màu xanh nếu đúng toàn bộ (từng giá trị ô một), đúng hết thì ra 1 thông báo Good. còn nếu chỉ cần 1 giá trị sai là exit thì làm như thế nào ah?
 
Lần chỉnh sửa cuối:
Upvote 0
Lequocvan đã viết:
Em muốn biết có cách nào phải so sánh từ A1, B1, C1, ... với tuần tự dãy màu xanh nếu đúng toàn bộ (từng giá trị ô một), đúng hết thì ra 1 thông báo Good. còn nếu chỉ cần 1 giá trị sai là exit thì làm như thế nào ah?
Nhấp chuột vào đây để mở rộng...

Như vầy được không:
Mã: 
Public dic As Object
Private Sub Auto_Open()
  Dim arr, item
  arr = Array("brcd", "custseq", "custnm", "apprseq", "apprdt", "apprmatdt", _
              "ccy", "appramt", "dsbsseq", "dsbsdt", "dsbsmatdt", "sprd", _
              "sprdpst", "dsbsamt", "dsbsccy", "rpmtamt", "intamt", "dsbsbal", _
              "dsbsamt2", "rpmtamt2", "intamt2", "subunit", "custstscd", "custtpcd", _
              "custtpnm", "custdtltpcd", "custdtltpnm", "ecomist", "ecomistnm", "taxtpcdloc", _
              "taxtpcdlocnm", "ofcno", "ofcnm", "pstintamt", "pstintamt2", "buscd", _
              "lntpcd", "lnsbtpcd", "lstrpmtdt", "lstintchrgprd", "nxtrpmtschddt", "nxtintschddt", _
              "exmtintamt", "exmtintamt2", "finainsttpcd", "finainsttpcdnm", "sicdloc", "province", _
              "provincenm", "district", "districtnm", "zipcd", "addr1", "secured", _
              "fndrstpcd", "fndrsnm", "exemptint", "exemptinttype", "fndprpstpcd", "fndprpstpcd_code", _
              "intrpmtamt", "AQCCDFIN", "intrpmtamt2", "commcd", "commmn", "grpno", _
              "trctcd", "trctnm", "BSNSSCLTPCD", "usrid", "usrnm", "acramt", _
              "lceqa", "yrdays", "intcmth", "intrpymth", "inttrmmth", "remark")
  If dic Is Nothing Then
    Set dic = CreateObject("Scripting.Dictionary")
    dic.CompareMode = vbTextCompare
    For Each item In arr
      dic.Add item, Nothing
    Next
  End If
End Sub
Sub msit80_kiemtra()
  Dim rng As Range, cel As Range, bChk As Boolean
  If dic Is Nothing Then Auto_Open
  Set rng = Range("A1", Range("A1").End(xlToRight))
  For Each cel In rng
    If Not dic.Exists(cel.Value) Then
      bChk = True
      Exit For
    End If
  Next
  If bChk Then
    MsgBox "Zero MSIT80 !!!!!"
  Else
    MsgBox "Good" & vbLf & "Good" & vbLf & "Good"
  End If
End Sub
 
Upvote 0
Dạ cám ơn Thầy nhưng ý của em là ktra lần lượt a1=brcd, b1=custseq, c1=custnm, ... bz1=remark. Nếu như đúng toàn bộ thì ra thông báo good; còn nếu chỉ cần ít nhất một trong những (78) phép so sánh trên có kết quả sai thì báo zero và thoát.
 
Upvote 0
Lequocvan đã viết:
Dạ cám ơn Thầy nhưng ý của em là ktra lần lượt a1=brcd, b1=custseq, c1=custnm, ... bz1=remark. Nếu như đúng toàn bộ thì ra thông báo good; còn nếu chỉ cần ít nhất một trong những (78) phép so sánh trên có kết quả sai thì báo zero và thoát.
Nhấp chuột vào đây để mở rộng...

Mã: 
Public Sub hello()
Dim arr, r As Long, dArr
arr = Array("brcd", "custseq", "custnm", "apprseq", "apprdt", "apprmatdt", _
              "ccy", "appramt", "dsbsseq", "dsbsdt", "dsbsmatdt", "sprd", _
              "sprdpst", "dsbsamt", "dsbsccy", "rpmtamt", "intamt", "dsbsbal", _
              "dsbsamt2", "rpmtamt2", "intamt2", "subunit", "custstscd", "custtpcd", _
              "custtpnm", "custdtltpcd", "custdtltpnm", "ecomist", "ecomistnm", "taxtpcdloc", _
              "taxtpcdlocnm", "ofcno", "ofcnm", "pstintamt", "pstintamt2", "buscd", _
              "lntpcd", "lnsbtpcd", "lstrpmtdt", "lstintchrgprd", "nxtrpmtschddt", "nxtintschddt", _
              "exmtintamt", "exmtintamt2", "finainsttpcd", "finainsttpcdnm", "sicdloc", "province", _
              "provincenm", "district", "districtnm", "zipcd", "addr1", "secured", _
              "fndrstpcd", "fndrsnm", "exemptint", "exemptinttype", "fndprpstpcd", "fndprpstpcd_code", _
              "intrpmtamt", "AQCCDFIN", "intrpmtamt2", "commcd", "commmn", "grpno", _
              "trctcd", "trctnm", "BSNSSCLTPCD", "usrid", "usrnm", "acramt", _
              "lceqa", "yrdays", "intcmth", "intrpymth", "inttrmmth", "remark")
dArr = [COLOR=#ff0000][SIZE=3][B]Sheet3[/B][/SIZE][/COLOR].Range("A1:BZ1").Value
For r = 1 To UBound(dArr, 2) Step 1
    If dArr(1, r) <> arr(r - 1) Then Exit For
Next
If r <= UBound(dArr, 2) Then MsgBox "error at cell " & Cells(1, r).Address Else MsgBox "Good"
End Sub
 
Upvote 0
Status
Không mở trả lời sau này.
Web KT

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

V
Help: Hàm đếm lọc giá trị trùng
Trả lời
12
Đọc
62
DeTong
D
T
tìm ra số tháng mà lượng hàng nhập ban đầu sử dụng hết
Trả lời
0
Đọc
26
TramAnhNguyen692
T
S
NHỜ ANH EM GIÚP MÌNH TÌM KIẾM DỮ LIỆU
Trả lời
11
Đọc
113
Duy Tùng 9x
Duy Tùng 9x
H
chuyển dữ liệu từ 1 dòng thành nhiều dòng,
Trả lời
8
Đọc
46
thuytrangbp28
T
B
XIN HƯỚNG DẪN CÁCH ĐỂ HÀM XLOOKUP TỰ NHẢY THEO SỐ LƯỢNG DÒNG CỦA ĐIỀU KIỆN KHÔNG SỬ DỤNG VBA
Trả lời
2
Đọc
32
Duy Tùng 9x
Duy Tùng 9x
C
Filter có điều kiện đang ở dạng Cột
Trả lời
2
Đọc
44
thuytrangbp28
T
L
Có ai biết fix lỗi này không ạ
    • Buồn
Trả lời
2
Đọc
40
lekimhuy0812
L
tonny jj
Lập hàm thể hiện số công lệnh của ngày đi công tác
Trả lời
5
Đọc
167
Gà Công Nghệ
Gà Công Nghệ
GPE-Trợ Lý
[GPE] TALKSHOW KHÁM PHÁ SỨC MẠNH HÀM FILTER TRONG EXCEL 365
    • Thích
Trả lời
1
Đọc
3K
PhanTuHuong
PhanTuHuong
K
Lỗi cấu trúc hình ảnh khi mở file bằng điện thoại
Trả lời
0
Đọc
32
Kecodonlalala
K
N
  • Question Question
Nhờ mọi người góp ý cho file Quản lý bán hàng viết bằng VBA đầu tay của mình (1 người xem)
    • Cảm ơn
    • Thích
Trả lời
7
Đọc
154
newbiexo
N
H
Xin được trợ giúp lỗi máy không mở được cửa sổ VBE.
Trả lời
3
Đọc
67
Nguyễn Duy Tuân
Nguyễn Duy Tuân
HeSanbi
  • Question Question
Sự khác nhau giữa book.Worksheets và book.Sheets trong Application
    • Thích
Trả lời
2
Đọc
142
Nguyễn Duy Tuân
Nguyễn Duy Tuân
PhanTuHuong
Hà Nội hẹn hò gặp gỡ đầu năm 2025 thôi :)
    • Thích
    • Yêu thích
Trả lời
7
Đọc
331
PhanTuHuong
PhanTuHuong
yeudoi
Cà phê giao lưu cùng thành viên kỳ cựu Cao Mạnh Sơn 19h 23/2/2025
    • Thích
    • Yêu thích
Trả lời
1
Đọc
70
PhanTuHuong
PhanTuHuong
DinhManh1307
Cách thống kê công việc sản xuất từng người để tính lương sản phẩm
Trả lời
8
Đọc
190
thuytrangbp28
T
K
Làm sao để ô excel hiển thị tên nhưng khi nhấp vào thì đó là công thức (1 người xem)
Trả lời
1
Đọc
48
pycckuu410
P
Nguyễn Duy Tuân
Phiên bản mới Add-in A-Tools v10 (2024)
    • Thích
2 3
Trả lời
41
Đọc
3K
Nguyễn Duy Tuân
Nguyễn Duy Tuân
ongke0711
  • Question Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba
    • Thích
    • Yêu thích
    • Cảm ơn
15 16 17
Trả lời
326
Đọc
25K
pycckuu410
P
V
  • Question Question
Đếm xếp loại của đơn hàng
Trả lời
8
Đọc
236
vanlinh_2904
V
Xem thêm…

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Đếm ngược thời gian

000
Ngày
00
Giờ
00
phút
00
giây
TALKSHOW KHÁM PHÁ SỨC MẠNH HÀM FILTER TRONG EXCEL 365
Back
Top Bottom