Chuyên mục xử lý, gỡ rối code VBA

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

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,922
Chao các anh!
Em có file giải lập bên dưới mục đích cũa em là:
- em cần copy dư liệu bên sheet "Index" vao các sheet "1,2,3,4..." tương ứng các ngày trong tháng VD: ngày mùng 03.10/2017 thì khi nhấn nút " nhap du lieu" thì sẻ chép dử liệu vào sheet("3") ( điều kiện lấy ở Ô "NGAY THANG")
// Sheets("locNT") với locNT=left(NGAYTHANG,..).value đại loại là thế.
THANK MỌI NGƯỜI.
 

File đính kèm

  • TestCopyAutoMacro.xlsm
    34.7 KB · Đọc: 4
Upvote 0
Bạn nên đổi lại tên các trang tính, như N01, N02,. . . N10,. . . .
& tham khảo macro sau:
PHP:
Sub TestCopy_GPE()
 Dim ShName As String
 ShName = "N" & Right("0" & CStr(Day([i1].Value)), 2)
 MsgBox ShName
 Sheets("Index").[K11:P11].Copy Destination:=Sheets(ShName).[D12]
 MsgBox "Chép Thành Công!"
End Sub
 
Upvote 0
Bạn nên đổi lại tên các trang tính, như N01, N02,. . . N10,. . . .
& tham khảo macro sau:
PHP:
Sub TestCopy_GPE()
 Dim ShName As String
 ShName = "N" & Right("0" & CStr(Day([i1].Value)), 2)
 MsgBox ShName
 Sheets("Index").[K11:P11].Copy Destination:=Sheets(ShName).[D12]
 MsgBox "Chép Thành Công!"
End Sub
Cảm ơn bạn Hoang2013 đã chi share, tên sheet mặc định cũa cty mặc định là “1,2,3,4..” theo 30 ngày trong tháng nên mình kg can thiệp vào đc chuyện đó.
 
Upvote 0
Vậy thì 1 trong 2 thứ í bị bệnh nặng lắm rồi: Excel hay Code của bạn!
Nếu là do Excel, thì cài lại;
Nếu là do Code thì nên đưa lên diễn đàn để i bác sỹ hội chẩn cho.

Chúc vui!
Dạ code của em đây ah. Nhờ mọi người xem giùm ah.
Modul loc_du_lieu chạy bình thường ah. Modul tan_suat_hd thì khi chạy là bị reset file excel ah.
 

File đính kèm

  • HD_PCC_17.xlsm
    793 KB · Đọc: 3
Upvote 0
Topic Những câu hỏi về code, xin giải thích các code... đã quá dài nên mình đóng nó lại và mở topic khác
Tất cả những bài viết liên quan đến việc nhờ giải thích, xử lý và gỡ rối code VBA, các bạn vui lòng đăng tại đây!
Cảm ơn

Private Sub CommandButton1_Click()

Dim endR As Long
With Sheets("sheet2")
endR = .Range("B" & Rows.Count).End(xlUp).Row

.Range("B" & endR + 1) = tensanpham.Text
.Range("C" & endR + 1).Select
.Range("D" & endR + 1) = thanhphan.Text
.Range("E" & endR + 1) = luatuoisudung.Text
.Range("F" & endR + 1) = cachdung.Text
.Range("G" & endR + 1) = xuatxu.Text
.Range("H" & endR + 1) = hang.Text
.Range("I" & endR + 1) = mucdich.Text

End With

tensanpham.Text = ""
thanhphan.Text = ""
luatuoisudung.Text = ""
cachdung.Text = ""
xuatxu.Text = ""
hang.Text = ""
mucdich.Text = ""


Dim strfile As String
Dim rng As Range
Dim sh As Shape
Const cfile As String = "imagefiles(*.bmp;*.gif;*.jpg;*.jpeg;*.png),"
strfile = Application.GetOpenFilename(filefilter:=cfile, Title:=es)
If strfile = "false" Then
Else
Set rng = ActiveCell
Set rng = rng.MergeArea
With rng
Set sh = ActiveSheet.Shapes.AddPicture(Filename:=strfile, linktofile:=msoFalse, savewithdocument:=msoTrue, Left:=.Left, Top:=.Top, Width:=.Width, Height:=.Height)

sh.LockAspectRatio = msoFalse
End With
Set sh = Nothing
Set rng = Nothing
End If


tensanpham.SetFocus

End Sub

mình bị báo lỗi như thế này bạn check hộ mình nhé
 

File đính kèm

  • 2.png
    2.png
    128.1 KB · Đọc: 4
  • Untitled.png
    Untitled.png
    132.4 KB · Đọc: 4
Upvote 0
đây là file excel nếu bác cần :( xem hộ em nhé cần gấp lắm
 

File đính kèm

  • 2.xlsm
    27.5 KB · Đọc: 1
Upvote 0
Mong được giải đáp
Tôi có làm các checkbox để ẩn hiện các cột cho tiện (như file đính kèm).
Việc sử dụng thì không sao. Tuy nhiên khi mở file ra, cấu hình trong form không đúng với thực tế. Cụ thể là khi bấm dấu kiểm nào đó vào thì 1 số cột tương ứng bị ẩn, nếu đóng file lại và có save sau đó mở ra, cột vẫn bị ẩn mà dấu kiểm không còn.
Có cách nào lưu giữ dấu kiểm khi mở file tương ứng với khi đóng file ?
Xin cảm ơn
 

File đính kèm

  • VD.xlsb
    44.2 KB · Đọc: 2
Upvote 0
Chào mọi người em đang gặp khó với VBA mong mọi người giúp đỡ với ah!

em muốn làm phần Hyperlink trong cột "File" thì phải làm thế nào ah, em mày mò hoài mà không ra được phần đó.
Em tự mày mò nên cũng chỉ biết hạn chế, mong mọi người giúp đỡ ah
em xin chân thành cảm ơn!

có bác nào giúp e cái này với :(
 

File đính kèm

  • cvden 2017.xlsx.xlsm
    22.1 KB · Đọc: 2
Upvote 0
Dạ code của em đây ah. Nhờ mọi người xem giùm ah.
Modul loc_du_lieu chạy bình thường ah. Modul tan_suat_hd thì khi chạy là bị reset file excel ah.
Mở module trước bình thường;
Mở cái bạn ghi sau nó báo lỗi "Error in loading DLL"
Đành chịu!
 
Upvote 0
Bạn đang gọi tới Sheet qua CodeName nên dùng cách sau. ;)
PHP:
Sub ClearRange(ByVal ws As Worksheet)
    With ws
        Union(.Range("P5:P40"), .Range("R5:R40"), .Range("T5:T40"), .Range("U5:Y40"), _
                .Range("AA5:AA40"), .Range("AC5:AC40"), .Range("AE5:AE40"), .Range("AF5:AL40")).ClearContents
    End With
End Sub

Private Sub CommandButton1_Click()
    '....'
    If pass = "123" Then
        Sheet1.Range("D6:F11").ClearContents
        Sheet2.Range("A5:R40").ClearContents
        ClearRange Sheet3
        ClearRange Sheet5
        ClearRange Sheet7
        ClearRange Sheet9
    Else
    '....'
End Sub
Rất cảm ơn bạn đã giúp đỡ. Tôi lại học được ở bạn một bài học mới.
 
Upvote 0
Bạn nên đổi lại tên các trang tính, như N01, N02,. . . N10,. . . .
& tham khảo macro sau:
PHP:
Sub TestCopy_GPE()
 Dim ShName As String
 ShName = "N" & Right("0" & CStr(Day([i1].Value)), 2)
 MsgBox ShName
 Sheets("Index").[K11:P11].Copy Destination:=Sheets(ShName).[D12]
 MsgBox "Chép Thành Công!"
End Sub
Nhờ các anh chỉ giúp mình muốn copy hàng dọc rồi paste vào hàng ngang trên VBA thì làm sao.
Và code " copy Destination" trên đó có y nghỉ gì?
Cảm Ơn mọi người giúp đở.
 

File đính kèm

  • TestCopyAutoMacro.xlsm
    35.4 KB · Đọc: 4
Upvote 0
Em có đoạn code sau:
PHP:
...
[AV9].Resize(Rws, 2).Value = FormatDateTime(dArr, vbShortTime)
...

Em muốn kết quả mảng trả về sẽ được định dạng dạng hh:mm, nhưng thử làm như vậy thì báo lỗi ở dòng này. Mọi người chỉ cho em nhé.
 
Upvote 0
Bạn kết bạn với bạn @vova2209 ấy, để nhóm học...
Lần trước làm sao có kết quả ngay thì lần này cũng làm vậy...

À mình muốn định dạng luôn cái mảng, nếu làm như hôm trước thì phải thêm dòng lệnh nữa. Nên mình hỏi xem có cách nào gọn hơn không.
 
Upvote 0
À mình muốn định dạng luôn cái mảng, nếu làm như hôm trước thì phải thêm dòng lệnh nữa. Nên mình hỏi xem có cách nào gọn hơn không.
Vụ nầy ... bạn gởi Mail nhờ ngài Bill tạo thêm lệnh mới Format một lần 2 em Range và Array khác nhau hoàn toàn
 
Upvote 0
Đấy là hệ quả của việc không thích ABC... mà cứ thích chơi với Z....
http://www.giaiphapexcel.com/diendan/threads/nhờ-tạo-form-list-box-tìm-kiếm.130636/

Dữ liệu trong mảng chờ gán xuống bảng tính thì nó cũng như dữ liệu nhập từ bàn phím, chuột, copy/paste ở nguồn khác.... vào bảng tính.
Muốn trông dữ liệu trên bảng tính hình thù ra làm sao thì phải do định dạng trên bảng tính quyết định.
 
Upvote 0
Mở module trước bình thường;
Mở cái bạn ghi sau nó báo lỗi "Error in loading DLL"
Đành chịu!
Dạ em sử dụng lệnh chỉ chạy office 2010 trở lên. 2007 ko chạy dc, nên báo lỗi Error in loading DLL.
em cài cả office 2007 và 2010 trên máy. ko biết có phải vì vậy mà khi chạy lệnh nó reset ko anh nhỉ?
 
Upvote 0
Bạn đang gọi tới Sheet qua CodeName nên dùng cách sau. ;)
PHP:
Sub ClearRange(ByVal ws As Worksheet)
    With ws
        Union(.Range("P5:P40"), .Range("R5:R40"), .Range("T5:T40"), .Range("U5:Y40"), _
                .Range("AA5:AA40"), .Range("AC5:AC40"), .Range("AE5:AE40"), .Range("AF5:AL40")).ClearContents
    End With
End Sub

Private Sub CommandButton1_Click()
    '....'
    If pass = "123" Then
        Sheet1.Range("D6:F11").ClearContents
        Sheet2.Range("A5:R40").ClearContents
        ClearRange Sheet3
        ClearRange Sheet5
        ClearRange Sheet7
        ClearRange Sheet9
    Else
    '....'
End Sub
Rất cảm ơn YOU, code chạy rất tốt. Xin YOU dành chút thì giờ giải thích dùm đoạn code để em út học hỏi kinh nghiệm. Rất mong sự giải thích của YOU. Cảm ơn nhiều lắm.
Sub ClearRange(ByVal ws As Worksheet)
With ws
Union(.Range("P5:p40"), .Range("R5:R40"), .Range("T5:T40"), .Range("U5:Y40"), _
.Range("AA5:AA40"), .Range("AC5:AC40"), .Range("AE5:AE40"), .Range("AF5:AL40")).ClearContents
End With
End Sub

Private Sub CommandButton1_Click()
'....'
If pass = "123" Then
Sheet1.Range("D6:F11").ClearContents
Sheet2.Range("A5:R40").ClearContents
ClearRange Sheet3
ClearRange Sheet5
ClearRange Sheet7
ClearRange Sheet9
Else
'....'
End Sub
 
Upvote 0
Status
Không mở trả lời sau này.
Web KT
Back
Top Bottom