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)

  • Thread starter Thread starter ST-Lu!
  • Ngày gửi Ngày gửi
Liên hệ QC

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

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:
Cấu trúc câu lệnh của bạn sai chứ gì!
Mã:
[COLOR=#0000cd][B]Private Sub Worksheet_Change(ByVal Target As Range)[/B][/COLOR]
    If Not Intersect(Target, Columns("D:D")) Is Nothing Then
        If Target.Value > 10 Then Target.Value = Target.Value / 10
    End If
End Sub
Em nghĩ đây không phải là nguyên nhân của vấn đề. Em nghĩ đến tình huống tác giả có 1 bảng điểm gồm nhiều sheet, mỗi sheet một lớp và tác giả muốn áp dụng code cho tất cả các sheet trong workbook. Trong tình huống này thì sử dụng sự kiện Workbook_SheetChange là phù hợp. Em nghĩ vấn đề ở chỗ tác giả đã đặt code không đúng chỗ: Sự kiện Workbook_SheetChange phải được đặt trong đối tượng ThisWorkbook chứ không phải đặt trong đối tượng Sheet1, Sheet2 hay Sheet..., ngược lại, sự kiện Worksheet_Change phải được đặt trong các đối tượng Worksheet.
 
Upvote 0
Em muốn tất cả sách Sheet đều được căn lề theo các thông số như sau:
PHP:
 .LeftMargin = Application.InchesToPoints(0.5)
        .RightMargin = Application.InchesToPoints(0.5)
        .TopMargin = Application.InchesToPoints(0.5)
        .BottomMargin = Application.InchesToPoints(0.5)
        .HeaderMargin = Application.InchesToPoints(0)
        .FooterMargin = Application.InchesToPoints(0)
        .PrintQuality = 600
        .CenterHorizontally = True
        .Orientation = xlLandscape
        .PaperSize = xlPaperA4
        .Zoom = 65

Xin hãy chỉ giúp em cách viết câu lệnh lựa chọn, thao tác với tất cả các Sheet với ah
 
Upvote 0
Em muốn tất cả sách Sheet đều được căn lề theo các thông số như sau:
PHP:
 .LeftMargin = Application.InchesToPoints(0.5)
        .RightMargin = Application.InchesToPoints(0.5)
        .TopMargin = Application.InchesToPoints(0.5)
        .BottomMargin = Application.InchesToPoints(0.5)
        .HeaderMargin = Application.InchesToPoints(0)
        .FooterMargin = Application.InchesToPoints(0)
        .PrintQuality = 600
        .CenterHorizontally = True
        .Orientation = xlLandscape
        .PaperSize = xlPaperA4
        .Zoom = 65

Xin hãy chỉ giúp em cách viết câu lệnh lựa chọn, thao tác với tất cả các Sheet với ah
1. Record macro với lệnh File\Page setup, bạn sẽ được một dãy code (tương tự như trên)
2. Thêm 1 vòng For để duyệt qua các sheet. Code có dạng như sau:
PHP:
Sub Test()
    Dim Sh As Worksheet
    For Each Sh In ThisWorkbook.Worksheets
        With Sh.PageSetup            
            'Đưa dãy lệnh trên vào đây'
        End With
    Next
End Sub
 
Upvote 0
Có thể lồng With trong With không ah

Em muốn toàn bộ các Sheet của em (cấu trúc như nhau) đều có đặc điểm
1. Từ A1:I1 sẽ áp dụng chế độ kẻ khung với các thông số như nhau:
PHP:
With Selection.Borders(xlEdgeLeft)
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .Weight = xlThin
    End With

Các ô từ A2:I100 thì đường viền của nó như sau:

PHP:
With Selection.Borders(xlEdgeLeft)
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.Weight = xlHairline

Vậy em phải rút viết thế nào ah, xin chân thành cảm ơn
 
Upvote 0
Em muốn toàn bộ các Sheet của em (cấu trúc như nhau) đều có đặc điểm
1. Từ A1:I1 sẽ áp dụng chế độ kẻ khung với các thông số như nhau:
PHP:
With Selection.Borders(xlEdgeLeft)
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .Weight = xlThin
    End With
    '......'
Các ô từ A2:I100 thì đường viền của nó như sau:
PHP:
'......'
With Selection.Borders(xlInsideHorizontal)
.Weight = xlHairline
Vậy em phải rút viết thế nào ah, xin chân thành cảm ơn
Tất nhiên có thể lồng With trong With được, nhưng bạn phải cẩn thận. Khi gõ một dấu chấm (.) bên trong câu lệnh With, bạn phải biết rằng bạn đang tác động đến đối tượng được đề cập trong câu lệnh With nào.
Nếu mục đích chỉ như bạn mô tả thì chẳng cần gì đến With. Bạn có thể sử dụng code sau:
PHP:
Sub KeKhung()
    Dim Sh As Worksheet
    For Each Sh In ThisWorkbook.Worksheets
        Sh.[A1:I100].Borders.Weight = xlThin
        Sh.[A2:I100].Borders(xlInsideHorizontal).Weight = xlHairline
    Next
End Sub
 
Upvote 0
Ồ bác anh Nghĩa Phúc làm ngắn gọn quá, đúng ý em rồi. trong khi Code thu từ Macro rất dài, nhưng em vẫn thắc mắc vùng A2:I100 sao anh viết ngắn thế thì làm sao máy nó hiểu khung viền ngoài là đường liền nhỉ (bởi em hiểu câu của anh chỉ có mỗi đường giữa thôi).

PHP:
Sh.[A2:I100].Borders(xlInsideHorizontal).Weight = xlHairline

Rất mong anh giải thích để em có thể mở mang được kiến thức của mình.
 
Upvote 0
Ồ bác anh Nghĩa Phúc làm ngắn gọn quá, đúng ý em rồi. trong khi Code thu từ Macro rất dài, nhưng em vẫn thắc mắc vùng A2:I100 sao anh viết ngắn thế thì làm sao máy nó hiểu khung viền ngoài là đường liền nhỉ (bởi em hiểu câu của anh chỉ có mỗi đường giữa thôi).
PHP:
Sh.[A2:I100].Borders(xlInsideHorizontal).Weight = xlHairline
Rất mong anh giải thích để em có thể mở mang được kiến thức của mình.
Thật đơn giản, chỉ vì đã có câu lệnh này ở trên: Sh.[A1:I100].Borders.Weight = xlThin, có nghĩa là toàn bộ vùng A1:I100 đã được thiết lập kiểu đường liền trước đó rồi. Bạn thử khóa 1 trong 2 câu lệnh này (đặt dấu nháy đơn vào trước câu lệnh) rồi chạy code (trên 1 Workbook chưa được định dạng khung) sẽ khám phá ra vấn đề.
 
Upvote 0
Nếu em thay
PHP:
Sub KeKhung()
    Dim Sh As Worksheet
    For Each Sh In ThisWorkbook.Worksheets
        Sh.[A1:I100].Borders.Weight = xlThin
        Sh.[A2:I100].Borders(xlInsideHorizontal).Weight = xlHairline
    Next
End Sub

bằng
PHP:
Sub KeKhung()
        For Each Sheet In ThisWorkbook.Worksheets
        Sh.[A1:I100].Borders.Weight = xlThin
        Sh.[A2:I100].Borders(xlInsideHorizontal).Weight = xlHairline
    Next
End Sub
Thì nó có tương đương không hả anh
 
Upvote 0
Nếu em thay
PHP:
Sub KeKhung()
    Dim Sh As Worksheet
    For Each Sh In ThisWorkbook.Worksheets
        Sh.[A1:I100].Borders.Weight = xlThin
        Sh.[A2:I100].Borders(xlInsideHorizontal).Weight = xlHairline
    Next
End Sub

bằng
PHP:
Sub KeKhung()
        For Each Sheet In ThisWorkbook.Worksheets
        Sh.[A1:I100].Borders.Weight = xlThin
        Sh.[A2:I100].Borders(xlInsideHorizontal).Weight = xlHairline
    Next
End Sub
Thì nó có tương đương không hả anh
Thứ nhất, VBA sẽ không hiểu anh chàng Sh là cái gì. Thứ 2, không nên sử dụng tên biến đặc biệt như "Sheet", bởi lẽ có thể trùng với từ khóa của VBA. Nếu bạn thay Sheet bởi Sh thì được. Có thể không khai báo biến Sh, nhưng nhìn chung thì khai báo tốt hơn. Hãy tập cho mình một thói quen tường minh trong viết code.
 
Upvote 0
Nếu em thay
PHP:
Sub KeKhung()
    Dim Sh As Worksheet
    For Each Sh In ThisWorkbook.Worksheets
        Sh.[A1:I100].Borders.Weight = xlThin
        Sh.[A2:I100].Borders(xlInsideHorizontal).Weight = xlHairline
    Next
End Sub

bằng
PHP:
Sub KeKhung()
        For Each Sheet In ThisWorkbook.Worksheets
        Sh.[A1:I100].Borders.Weight = xlThin
        Sh.[A2:I100].Borders(xlInsideHorizontal).Weight = xlHairline
    Next
End Sub
Thì nó có tương đương không hả anh

Phải là
PHP:
Sub KeKhung()
        For Each Sheet In ThisWorkbook.Worksheets
        Sheet.[A1:I100].Borders.Weight = xlThin
        Sheet.[A2:I100].Borders(xlInsideHorizontal).Weight = xlHairline
    Next
End Sub
 
Upvote 0
Nếu em thay
PHP:
Sub KeKhung()
    Dim Sh As Worksheet
    For Each Sh In ThisWorkbook.Worksheets
        Sh.[A1:I100].Borders.Weight = xlThin
        Sh.[A2:I100].Borders(xlInsideHorizontal).Weight = xlHairline
    Next
End Sub

bằng
PHP:
Sub KeKhung()
        For Each Sheet In ThisWorkbook.Worksheets
        Sh.[A1:I100].Borders.Weight = xlThin
        Sh.[A2:I100].Borders(xlInsideHorizontal).Weight = xlHairline
    Next
End Sub
Thì nó có tương đương không hả anh
Tự mình thí nghiệm, xem kết quả và tự rút ra kết luận
Mấy cái này thay vì hỏi, bạn làm thử có phải hơn không
 
Upvote 0
Tôi tạo một From trong đó gồm có 3 TextBox. TextBox1 và TextBox2 đều có gán số liệu, tôi muốn lấy TextBox1 trừ TextBox2 cho ra kết quả ở TextBox3. Tôi tìm kiếm hoài không thấy, nhờ giúp cho. Cám ơn
 
Upvote 0
Tôi tạo một From trong đó gồm có 3 TextBox. TextBox1 và TextBox2 đều có gán số liệu, tôi muốn lấy TextBox1 trừ TextBox2 cho ra kết quả ở TextBox3. Tôi tìm kiếm hoài không thấy, nhờ giúp cho. Cám ơn

Bạn thêm 1 nút lệnh nữa cho form và gán code vào nó như sau:

PHP:
Private Sub CommandButton1_Click()
    TextBox3 = Val(TextBox1) - Val(TextBox2)
End Sub
 
Upvote 0
Cám ơn Hoàng Trọng Nghĩa, code đó khi tôi kích vào CommandButton ngoài bảng tính thì nó không hiển thị kết quả, bạn xem lại dùm.
 
Upvote 0
Trong đoạn code dưới đây: (chỗ mình tô màu đỏ, mình chưa hiểu lắm cách dùng hàm find trong VBA trong công thức thì mình biết dùng còn trong VBA thì mình chưa hiểu lắm không biết các tham số khi dùng hàm nó có giống khi dùng VBA không?) Thanks
Sub Timkiem()
Dim DMHH As Range, KQ As Range, clls As Range
With Sheets("DM-KH")
Set DMHH = .Range("A2:A" & .Range("A65000").End(xlUp).Row)
End With
For Each clls In Sheets("BC").Range("A2:A20")
Set KQ = DMHH.Find(clls.Value, , xlValues, xlWhole, xlByRows, xlNext, , , False)
If KQ Is Nothing Then
clls.Offset(, 1).Value = ""
clls.Offset(, 2).Value = ""
Else
clls.Offset(, 1).Value = KQ.Offset(, 1).Value
clls.Offset(, 2).Value = KQ.Offset(, 2).Value
End If
Next
End Sub
 
Upvote 0
Cái đó thường được gọi là fương thức, không fải là hàm!

Trong đoạn code dưới đây: (chỗ mình tô màu đỏ, mình chưa hiểu lắm cách dùng hàm find trong VBA trong công thức thì mình biết dùng còn trong VBA thì mình chưa hiểu lắm không biết các tham số khi dùng hàm nó có giống khi dùng VBA không?) Thanks
PHP:
Sub Timkiem()
  Dim DMHH As Range, KQ As Range, clls As Range
  With Sheets("DM-KH")
     Set DMHH = .Range("A2:A" & .Range("A65000").End(xlUp).Row)
   End With
  For Each clls In Sheets("BC").Range("A2:A20")
         Set KQ = DMHH.Find(clls.Value, , xlValues, xlWhole, xlByRows, xlNext, , , False)
             If KQ Is Nothing Then
                       clls.Offset(, 1).Value = "":                clls.Offset(, 2).Value = ""
             Else
                     clls.Offset(, 1).Value = KQ.Offset(, 1).Value
                     clls.Offset(, 2).Value = KQ.Offset(, 2).Value
    End If
 Next
End Sub

Bạn tìm http://www.giaiphapexcel.com/forum/...p-về-phương-thức-tìm-kiếm-FIND-(-Find-Method)
& http://www.giaiphapexcel.com/forum/...ảo-luận-về-phương-thức-tìm-kiếm-METHOD-FIND()
nói rất rõ!
 
Upvote 0
Cám ơn Hoàng Trọng Nghĩa, File DV đây! nhờ AC và các bạn giúp dùm.

Bạn không trừ được là do bạn định dạng ở các Textbox.

Kiểu định dạng này được hiểu là Text mà đã vậy thì thêm Val nó chỉ lấy giá trị số trước dấu phẩy (,) còn những số sau dấu phẩy nó không quan tâm.

Nói thêm là khi bạn chọn sự kiện Change để format kiểu như thế, bạn sẽ gặp rắc rối nếu bạn đánh số thập phân, VD bạn muốn gõ 50,000.599 chẳng hạn, tôi nghĩ nó sẽ không cho làm điều đó!


Vậy để trừ được 2 textbox với nhau, bạn cần phải loại bỏ dấu phẩy ra để cho nó trở về dạng số, tôi làm 1 hàm như sau:

PHP:
Function LoaiDau(ByVal numb As String) As Double
    On Error GoTo ExitFunction
    LoaiDau = Replace(numb, ",", "")
ExitFunction:
End Function

Và thêm nút CommandButton vào Form, thủ tục như sau:

PHP:
Private Sub CommandButton1_Click()
  TextBox3.Value = LoaiDau(TextBox1.Value) - LoaiDau(TextBox2.Value)
End Sub

Nếu bạn muốn định dạng cho Textbox3 thì cũng định dạng như các textbox khác:

PHP:
Private Sub TextBox3_Change()
  TextBox3.Value = Format(TextBox3.Value, "#,##0")
End Sub

Bạn cũng có thể nhân cho 1 (chia cho 1) để loại bỏ dấu:

PHP:
Private Sub CommandButton1_Click()
  TextBox3.Value = 1 * TextBox1.Value - 1 * TextBox2.Value
End Sub

Tuy nhiên cách nhân cho 1 này thường phát sinh lỗi nếu 1 trong 2 textbox có giá trị là chuỗi hoặc rỗng.

Tới đây chắc bạn đã làm được.
 
Lần chỉnh sửa cuối:
Upvote 0
Code đúng sao không chạy được?

Em có đoạn code sau

PHP:
With target
If .Address = "$B$5" And Right([B5], 7) <> "dacbiet" Then
                
                [C8:D8].ClearContents
                [B11:D13].ClearContents
                [D6].ClearContents
                With Sheet5
                Select Case Left([B5], 3)
                        
                        Case "DEM"
                        [D6] = IIf(Right([B5], 4) = "nhap", .[n1], .[N6]) ' so ngay mien DEM
                        [B12] = IIf(Right([B5], 4) = "nhap", .[k2], .[k7]) ' muc 1 cont 20 nhap & xuat
                        [B13] = IIf(Right([B5], 4) = "nhap", .[k3], .[k8]) ' muc 2 cont 20 nhap & xuat
                        [C12] = IIf(Right([B5], 4) = "nhap", .[L2], .[L7]) ' muc 1 cont 40 nhap & xuat
                        [C13] = IIf(Right([B5], 4) = "nhap", .[L3], .[L8]) ' muc 2 cont 40 nhap & xuat
                        [D12] = IIf(Right([B5], 4) = "nhap", .[M2], .[M7]) ' muc 1 cont 45 nhap & xuat
                        [D13] = IIf(Right([B5], 4) = "nhap", .[M3], .[M8]) ' muc 2 cont 45 nhap & xuat
                        
                        Case "DET"
                        [D6] = IIf(Right([B5], 4) = "nhap", .[T1], .[T6]) ' so ngay mien DET
                        [B12] = IIf(Right([B5], 4) = "nhap", .[Q2], .[Q7]) ' muc 1 cont 20 nhap & xuat
                        [C12] = IIf(Right([B5], 4) = "nhap", .[R2], .[R7]) ' muc 1 cont 40 nhap & xuat
                        [D12] = IIf(Right([B5], 4) = "nhap", .[s2], .[S7]) ' muc 1 cont 45 nhap & xuat
                        
                        
                End Select
                
                End With

        
        End If
End with

Đoạn code trên test ok trên máy em.
Khi đêm file này sang dùng trên 1 máy khác thì code trên không chạy (test các code khác chạy bình thường ví dụ test bằng msgbox...)

Như vậy có phải máy bạn em có chỗ nào chưa thiết lập không?
Xin chỉ giúp

Em cám ơn nhiều
 
Upvote 0
Em gửi file cho dễ hình dung nhé
Tại sheets("Hạch toán") khi cập nhật ô [B5] thì giá sẽ được cập nhật tại vùng [B11:D13]
Em đã test ok trên vài máy tính, nhưng khi đem sang một máy tính đang cần dùng file này thì code ko chạy

Em nghĩ là máy tính người này đang thiếu một thiết lập nào đó

Anh/chị test thử code có chạy ko nhé. Nếu code chạy, xin chỉ giúp em cách để máy bạn em có thể chạy được code

xin cám ơn
 
Lần chỉnh sửa cuối:
Upvote 0
Em đã phát hiện ra là tại máy bạn em "BỊ HIỆN TƯỢNG" sau
- tại sheet2.[B5], Sau khi chọn giá trị từ ô B5 (các máy khác là code sẽ chạy luôn với sự kiện worksheet_change
- Riêng tại máy bạn em lại phải thêm một chặng nữa (F2) vào ô B5 & Enter

sau khi F2 & enter thì code trên mới chạy

Em xin hỏi đây là hiện tượng gì, có cách nào khắc phục không?

Em xin cám ơn
 
Upvote 0
Em đã phát hiện ra là tại máy bạn em "BỊ HIỆN TƯỢNG" sau
- tại sheet2.[B5], Sau khi chọn giá trị từ ô B5 (các máy khác là code sẽ chạy luôn với sự kiện worksheet_change
- Riêng tại máy bạn em lại phải thêm một chặng nữa (F2) vào ô B5 & Enter

sau khi F2 & enter thì code trên mới chạy

Em xin hỏi đây là hiện tượng gì, có cách nào khắc phục không?

Em xin cám ơn
Thì ít ra bạn cũng cho file lên chứ ---> "Chay" thế này thì biết chừng nào mới "tăng dân số" được đây?
 
Upvote 0
To Tường_Vi: Lòng vòng từ chiều tới giờ thì vẫn không thấy file đâu cả, biết đường nào mà lần?!
 
Upvote 0
Em xin phép gửi file ah
 

File đính kèm

Upvote 0
đã có 11 một lượt tải, chắc các anh chị thấy code vẫn chạy tốt phải không?

Em vẫn không sao tìm ra được nguyên nhân vì code không chạy (trên máy bạn em) sau khi đã chọn list tại validation (nghĩa là đã có sự kiện worksheet_change)

Code chỉ chạy khi, mình F2 (hoặc nháy đúp) rồi enter

Hic
 
Upvote 0
Xin chỉ giúp cách sử dụng hàm Mid trong VBA

Tôi viết thế này nhưng chưa được, vậy phải viết thế nào mới đúng

PHP:
Sub trich()
i = Mid(Cells(1, 1), ":", Len(Cells(1, 1)))
MsgBox i
End Su
 
Upvote 0
Tôi viết thế này nhưng chưa được, vậy phải viết thế nào mới đúng

PHP:
Sub trich()
i = Mid(Cells(1, 1), ":", Len(Cells(1, 1)))
MsgBox i
End Su

Thế hàm MID trên bảng tính bạn dùng thế nào thì trong VBA cũng dùng như thế
Cú pháp: Mid(Chuổi, vị trí bắt đầu, độ dài)
Ở code trên, vị trí bắt đầu của bạn là ":" sao mà được chứ ---> Nó phải là con số cụ thể
Còn nếu muốn tìm vị trí của dấu ":" thì phải dùng InStr... Ví dụ thế này: InStr(Cells(1,1), ":") (gần giống với hàm FIND trong Excel)
Hoặc nếu muốn tách chuổi từ dấu ":" trở đi thì: Mid(Cells(1, 1), InStr(Cells(1,1), ":"), Len(Cells(1, 1)))
 
Upvote 0
Nhờ sửa giúp code

Em có một code nhập dữ liệu, nay em muốn sau mỗi lần nhập thì form tự động xóa và khi nhập thiếu một cell bắt buộc nào đó thì code thông báo và không cho nhập. Nhờ các bác chỉ bảo, xin cám ơn.

Sub Nhap()
'
'
Sheets("Nhap").Select: Range("B3:B17").Select
Selection.Copy
Sheets("Data").Select
Range("H65535").Select
Selection.End(xlUp).Select
Selection.Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=True
Application.CutCopyMode = False: Sheets("Nhap").Select


End Sub
 
Upvote 0
Em có một code nhập dữ liệu, nay em muốn sau mỗi lần nhập thì form tự động xóa và khi nhập thiếu một cell bắt buộc nào đó thì code thông báo và không cho nhập. Nhờ các bác chỉ bảo, xin cám ơn.

Sub Nhap()
'
'
Sheets("Nhap").Select: Range("B3:B17").Select
Selection.Copy
Sheets("Data").Select
Range("H65535").Select
Selection.End(xlUp).Select
Selection.Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=True
Application.CutCopyMode = False: Sheets("Nhap").Select


End Sub
Sao bạn bạn không đưa file lên để mọi người test?
 
Upvote 0
Vì em nghĩ chỉ thêm dòng lệnh vào code thôi nên tiết kiệm dung lượng chút. Em xin gửi lên ạ.
 

File đính kèm

Upvote 0
Vì em nghĩ chỉ thêm dòng lệnh vào code thôi nên tiết kiệm dung lượng chút. Em xin gửi lên ạ.
Trong Form nhập của bạn mình thấy chỉ có 3 ô bắt buộc nhập là: D9, D10 và D14. Vậy code có thể là
PHP:
If Sheet1.Range("D9") = "" Or Sheet1.Range("D10") = "" Or Sheet1.Range("D14") = "" Then
    MsgBox "Ban nhap chua du"
   Exit Sub
Else
         Code của bạn......
    Sheet1.Range("D9:D10").ClearContents
    Sheet1.Range("D14").ClearContents
End If
 
Upvote 0
Viehoai ơi viết như thế nào để code không xóa công thức lúc đó chỉ cần viết Sheet1.Range("D9:D14").Clear..."trừ công thức"
 
Upvote 0
Viehoai ơi viết như thế nào để code không xóa công thức lúc đó chỉ cần viết Sheet1.Range("D9:D14").Clear..."trừ công thức"
Những ô nhập là những ô đâu có công thức hả bạn?
(nghĩ cũng lạ, bạn làm được file hoành tráng thế mà hỏi câu không đâu vào đâu nhỉ?)
 
Lần chỉnh sửa cuối:
Upvote 0
Những công thức để hỗ trợ người nhập mà. Tất cả những cell màu xanh đều có công thức mà, trừ D9, D10, D14 thôi.
 
Upvote 0
Cảm ơn Viehoai nhé vì mình thấy có code xóa được như vậy mà ví dụ:
Sub Nhap()
'
'
'
Dim historyWks As Worksheet
Dim inputWks As Worksheet

Dim nextRow As Long
Dim oCol As Long

Dim myRng As Range
Dim myCopy As String
Dim myCell As Range

myCopy = "D6:D14" 'Nguon Du Lieu

Set inputWks = Worksheets("Nhap")
Set historyWks = Worksheets("DaTa")
With historyWks
nextRow = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0).Row
End With
With inputWks
Set myRng = .Range(myCopy)
If Sheet1.Range("D9") = "" Or Sheet1.Range("D10") = "" Or Sheet1.Range("D14") = "" Then
MsgBox
"Ban nhap chua du"

Exit Sub
End If
End With
oCol = 1
For Each myCell In myRng.Cells
historyWks.Cells(nextRow, oCol).Value = myCell.Value
oCol = oCol + 1
Next myCell
With inputWks
On Error Resume Next
With .Range(myCopy).Cells.SpecialCells(xlCellTypeConstants)
.ClearContents
Application.GoTo .Cells(1)
End With
On Error GoTo 0
End With
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
Cảm ơn Viehoai nhé vì mình thấy có code xóa được như vậy mà ví dụ:
Sub Nhap()
'
'
'
Dim historyWks As Worksheet
Dim inputWks As Worksheet

Dim nextRow As Long
Dim oCol As Long

Dim myRng As Range
Dim myCopy As String
Dim myCell As Range

myCopy = "D6:D14" 'Nguon Du Lieu

Set inputWks = Worksheets("Nhap")
Set historyWks = Worksheets("DaTa")
With historyWks
nextRow = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0).Row
End With
With inputWks
Set myRng = .Range(myCopy)
If Sheet1.Range("D9") = "" Or Sheet1.Range("D10") = "" Or Sheet1.Range("D14") = "" Then
MsgBox
"Ban nhap chua du"

Exit Sub
End If
End With
oCol = 1
For Each myCell In myRng.Cells
historyWks.Cells(nextRow, oCol).Value = myCell.Value
oCol = oCol + 1
Next myCell
With inputWks
On Error Resume Next
With .Range(myCopy).Cells.SpecialCells(xlCellTypeConstants)
.ClearContents
Application.GoTo .Cells(1)
End With
On Error GoTo 0
End With
End Sub
Vì khối lượng cell xóa it nên không dùng theo kiểu vậy thôi. Nếu thích thì dùng
PHP:
Sheet1.Range("D9:D14").Cells.SpecialCells(xlCellTypeConstants).ClearContents
 
Upvote 0
Nhờ sửa sai Code Copy

Tôi thực hiện lệnh Copy nhưng không biết sai ở đâu, nhờ các bác chỉ dùm
PHP:
Sub Copy()
Sheets("Sheet1").UsedRange.Copy
Sheets("Sheet2").UsedRange.Paste
End Sub
 
Upvote 0
Tôi thực hiện lệnh Copy nhưng không biết sai ở đâu, nhờ các bác chỉ dùm
PHP:
Sub Copy()
Sheets("Sheet1").UsedRange.Copy
Sheets("Sheet2").UsedRange.Paste
End Sub
Với đối tượng Range, không có phương thức Paste mà chỉ có phương thức PasteSpecial. Bạn sửa lại thành PasteSpecial và chọn tùy chọn thích hợp là được. Tuy nhiên không nên chọn UsedRange ở sheet2 mà chỉ nên chọn 1 ô nào đó thôi để tránh paste thừa, thiếu.
2 câu lệnh trên có thể thay bởi câu lệnh: Sheets("Sheet1").UsedRange.Copy Sheets("Sheet2").[A1]
 
Upvote 0
Bạn thử liều mình với cái này cho vui

PHP:
Sub Copy()
   Dim Rng As Range
   
   Set Rng = Sheets("GPE").UsedRange
    Sheet1.UsedRange.Copy Destination:=Rng(2)
End Sub
 
Upvote 0
đã có 11 một lượt tải, chắc các anh chị thấy code vẫn chạy tốt phải không?

Em vẫn không sao tìm ra được nguyên nhân vì code không chạy (trên máy bạn em) sau khi đã chọn list tại validation (nghĩa là đã có sự kiện worksheet_change)

Code chỉ chạy khi, mình F2 (hoặc nháy đúp) rồi enter

Hic

Em nghĩ là do file nhưng không tìm ra nguyên nhân
Vì trên máy bạn em, em test sự kiện worksheet_change với file khác với chạy tốt

Riêng file test trên phải F2 & enter code mới chạy
Có ai biết nguyên nhân tại sao không?
 
Upvote 0
Theo ngu ý của tôi, thường copy, paste viết cho gọn makhồng bị rằng buộc nhiều điều kiện khac hay logic phải như thế nào, thì đơn giản viết

Mã:
    With Worksheets("sheet1").Range("a1") 
        .End(xlDown).Copy Destination:=Worksheets("sheet2").Range("C1") 
    End With
 
Upvote 0
Vẫn còn lơ mơ giữa mảng 1 chiều, mảng 2 chiều và Variant

Em thử Code này nhưng lỗi, xin hãy sửa lại dùm giúp em

PHP:
Sub Thunghiem()
Dim Arr, Tmp
Set Arr = Range("A1:B1000")
Tmp = Arr
i = UBound(Arr, 1)
MsgBox i
End Sub
 
Upvote 0
Em thử Code này nhưng lỗi, xin hãy sửa lại dùm giúp em

PHP:
Sub Thunghiem()
Dim Arr, Tmp
Set Arr = Range("A1:B1000")
Tmp = Arr
i = UBound(Arr, 1)
MsgBox i
End Sub
Bạn thử thế này nhé:
PHP:
Sub Thunghiem()
Dim Arr, Tmp
Arr = Range("A1:B1000").Value
Tmp = Arr
i = UBound(Arr, 1)
MsgBox i
End Sub
 
Upvote 0
Em thử Code này nhưng lỗi, xin hãy sửa lại dùm giúp em

PHP:
Sub Thunghiem()
Dim Arr, Tmp
Set Arr = Range("A1:B1000")
Tmp = Arr
i = UBound(Arr, 1)
MsgBox i
End Sub

Bạn đã Set Arr = Range("A1:B1000") ---> Chứng tỏ ArrRange (nếu bỏ từ Set đi thì Arr sẽ là Array)
Mà Range thì làm quái gì có UBound hay LBound
Thế nhưng khi bạn gán Tmp = Arr thì Tmp chắc chắn là Array
Nếu viết i = UBound(Tmp, 1) sẽ không có vấn đề
 
Upvote 0
Giúp em về sử dụng hàm Join

Em có 2 cột A và B có số phần tử như nhau, em muốn nối 2 cột A và B bằng hàm Join trong VBA thì phải viết thế nào?

Kết quả minh họa tại cột C màu đỏ theo file em đính kèm

(Mục đích của em là muốn học hàm Join trong VBA)
 

File đính kèm

Upvote 0
Em có 2 cột A và B có số phần tử như nhau, em muốn nối 2 cột A và B bằng hàm Join trong VBA thì phải viết thế nào?

Kết quả minh họa tại cột C màu đỏ theo file em đính kèm

(Mục đích của em là muốn học hàm Join trong VBA)
Hàm Join chỉ dùng được với mảng 1 chiều! Vậy nếu bạn có 1 mảng 2 chiều thì đầu tiên phải chuyển nó thành 1 chiều trước (bằng vòng lập), xong rồi cứ Join thôi
Riêng bài của bạn: Nói chuổi theo dòng (cùng dòng nối với nhau), vậy thì cứ dùng toán tử & mà nối, cần gì Join chứ
 
Upvote 0
Em vẫn đang ôn lại cái vụ mảng 1 chiều, mảng 2 chiều. Em viết như sau nhưng không được, mong mọi người chữa lại hộ
PHP:
Sub Thu()
Dim Arr(), MyRng As Range
Set MyRng = Sheet1.Range("A1:A10")
Arr = Application.WorksheetFunction.Transpose(MyRng)
MsgBox Arr(1, 4)
End Sub

----------------
Riêng bài của bạn: Nói chuổi theo dòng (cùng dòng nối với nhau), vậy thì cứ dùng toán tử & mà nối, cần gì Join chứ

Bài này dùng toán tử thì dễ rồi, nhưng vì chưa va chạm với hàm Join nên em thử xem cách dùng của nó ở ví dụ đơn giản xem thế nào thôi ah.
 
Upvote 0
Sau khi bạn dùng xong Transpose, Arr của bạn là mảng 1 chiều do vậy sửa lại đúng là
PHP:
Sub Thu()
Dim Arr(), MyRng As Range
Set MyRng = Sheet1.Range("A1:A10")
Arr = Application.WorksheetFunction.Transpose(MyRng)
MsgBox Arr(4)
End Sub

Bạn nên tìm tài liệu mà thày Ndu tặng diễn đàn tại địa chỉ http://www.giaiphapexcel.com/forum/showthread.php?50420-Code-xoá-Thư-mục/page2 , trong đó có rất nhiều ví dụ hay bạn tha hồ mà thực tập.
-------------------
Gửi bạn 1 ví dụ về Join của thày Ndu:
PHP:
Option Explicit
Function JoinText(ByVal SrcText, Optional Sep As String = vbLf) As String
  Dim Tmp, Arr
  On Error GoTo Stp1
  With WorksheetFunction
    Arr = .Transpose(SrcText)
    GoTo Stp2
Stp1:
    Arr = .Transpose(.Transpose(SrcText))
Stp2:
    Tmp = Join(Arr, vbTab)
    Tmp = Replace(Tmp, " ", vbBack)
    Tmp = Replace(Tmp, vbTab, " ")
    Tmp = .Trim(Tmp)
    Tmp = Replace(Tmp, " ", vbTab)
    Tmp = Replace(Tmp, vbBack, " ")
    Tmp = Replace(Tmp, vbTab, Sep)
  End With
  JoinText = Tmp
End Function
 
Lần chỉnh sửa cuối:
Upvote 0
=

Bạn nên tìm tài liệu mà thày Ndu tặng diễn đàn tại địa chỉ http://www.giaiphapexcel.com/forum/showthread.php?50420-Code-xoá-Thư-mục/page2 , trong đó có rất nhiều ví dụ hay bạn tha hồ mà thực tập.
-------------------
Gửi bạn 1 ví dụ về Join của thày Ndu:
PHP:
Option Explicit
Function JoinText(ByVal SrcText, Optional Sep As String = vbLf) As String
  Dim Tmp, Arr
  On Error GoTo Stp1
  With WorksheetFunction
    Arr = .Transpose(SrcText)
    GoTo Stp2
Stp1:
    Arr = .Transpose(.Transpose(SrcText))
Stp2:
    Tmp = Join(Arr, vbTab)
    Tmp = Replace(Tmp, " ", vbBack)
    Tmp = Replace(Tmp, vbTab, " ")
    Tmp = .Trim(Tmp)
    Tmp = Replace(Tmp, " ", vbTab)
    Tmp = Replace(Tmp, vbBack, " ")
    Tmp = Replace(Tmp, vbTab, Sep)
  End With
  JoinText = Tmp
End Function
Code này viết từ hồi... xưa!
Hồi ấy viết thể tưởng là rất hay, giờ nhìn lại cũng thấy mắc cười
Ẹc... Ẹc...
 
Upvote 0
Tiện thể nhìn lại bài trước, thày cải tiến lại luôn giúp em thày nhé.
 
Lần chỉnh sửa cuối:
Upvote 0
Dấu hiệu nào để nhận biết cái nào là mảng 2 chiều, khi nào tạo ra mảng 1 chiều nhỉ?
 
Lần chỉnh sửa cuối:
Upvote 0
Dấu hiệu nào để nhận biết cái nào là mảng 2 chiều, khi nào tạo ra mảng 1 chiều nhỉ?
- Một mảng do chính bạn tự tạo ra, đương nhiên bạn phải biết mảng ấy là mấy chiều rồi, đúng không?
- Còn lại, mảng là sản phẩm của 1 code nào đó tạo ra, hoặc được gán từ 1 mảng khác thì buộc... phải nhớ
Ví dụ:
- Mảng được gán từ Range luôn là mảng 2 chiều (Base 1)
- Mảng lấy từ Dictionary (Dic.Keys, Dic.Items) luôn là mảng 1 chiều (Base 0)
- Tham số chính của ParamArray luôn là mảng 1 chiều (Base 0)
- Mảng được tạo thành từ hàm Split luôn là mảng 1 chiều (Base 0)
- Mảng được lấy từ List của ComboBox, ListBox luôn là mảng 2 chiều (Base 0)
vân vân....
 
Upvote 0
Dấu hiệu nào để nhận biết cái nào là mảng 2 chiều, khi nào tạo ra mảng 1 chiều nhỉ?

Thế bạn nhìn "cụm ô" A1:A10 thấy nó giống cái gì? Giống một mảng một chiều "dựng đứng" chứ gì. "Dựng đứng" là nói thế vì con người có khái niệm "trái phải, trên, dưới, đứng, ngang"
Còn "cụm ô" A1:C10 nó giống cái gì? Chắc chắn nó không gợi tới mảng một chiều.
Tôi chả hiểu Range nó là cái gì, nó có cấu trúc thế nào. Tôi dùng "trực giác", bạn có hiểu không?
Trực giác thì nhớ lâu.
Đấy là tôi nói về kết quả sau khi gán ... Transpose như trong code (đã xóa) của bạn
 
Lần chỉnh sửa cuối:
Upvote 0
PHP:
'Dim <ten bien> as <kieu_du_lieu>'
'Set <ten bien> = New <Kieu_du_lieu>'
Dim WsN As Worksheet
Dim WsD As Worksheet
Dim m, n, I, J As Long 'Long:gia tri kieu nguyen'
'm: dong cuoi cua NKC
'n: dong cuoi cua So cai'

Mã:
Sub LocForNext()
    Application.ScreenUpdating = False
    On Error GoTo Thoat
                               'WsN dai dien cho sheet NKC'
                               'WsD dai dien cho sheet So cai'
    Set WsN = Worksheets("NKC") 'phep' gan' doi tuong. voi tu khoa Set'
    Set WsD = Worksheets("SOCAI")
                                   'gan' Vung la khoang(A1:B3) nam trong sheet NKC '
    Set Vung = WsD.Range("A1:B3")  'range la khoang?'
                             'dongcuoi=Range("A1").End(xlDown).Row cho ke't qua? dongcuoi=102'
    m = WsN.Range("D65000").End(xlUp).Row 'WsN dai dien cho sheet NKC''LRow = ActiveSheet.Cells(65536, iCol).End(xlUp).Row'
    n = WsD.Range("D65000").End(xlUp).Row 'WsD dai dien cho sheet NKC'
    tk = WsD.Range("D5").Value 'tk = duoc gan'o^ D5 'So cai'  Value: gia' tri.'
    'Xoa du lieu cu cua sheet SOCAI 'so duoc lay du lieu'
    If n > 10 Then WsD.Range("A11:G" & n).Clear
    'Dung vong lap de gan du lieu
    [U]For I = 9 To m   ' lap 9 vong cua NKC'
        If WsN.Range("F" & I) = tk Then ' i la mot bien so ''F,B,E,G la cac' cot trong So? Cai'
            n = WsD.Range("D65000").End(xlUp).Row  'WsN dai dien cho sheet NKC'
            WsN.Range("B" & I & ":E" & I).Copy Destination:=WsD.Range("A" & n + 1)
            WsD.Range("E" & n + 1) = WsN.Range("G" & I)
            WsD.Range("F" & n + 1) = WsN.Range("H" & I)
        ElseIf WsN.Range("G" & I) = tk Then
            n = WsD.Range("D65000").End(xlUp).Row
            WsN.Range("B" & I & ":E" & I).Copy Destination:=WsD.Range("A" & n + 1)
            WsD.Range("E" & n + 1) = WsN.Range("F" & I)
            WsD.Range("G" & n + 1) = WsN.Range("H" & I)
        End If
    Next
    n = WsD.Range("D65000").End(xlUp).Row
    WsD.Range("A11:G" & n + 2).Font.Size = 8
    WsD.Range("F11:G" & n + 2).NumberFormat = "#,##0"
    WsD.Range("D" & n + 1) = WsD.Range("D1")
    WsD.Range("D" & n + 2) = WsD.Range("D2")
    WsD.Range("F" & n + 1 & ":G" & n + 1).Formula = "=SUM(R11C:R" & n & "C)"
    WsD.Range("F" & n + 1 & ":G" & n + 1).Value = WsD.Range("F" & n + 1 & ":G" & n + 1).Value
    Tong = WsD.Range("F10") - WsD.Range("G10") + WsD.Range("F" & n + 1) - WsD.Range("G" & n + 1)
    If Tong > 0 Then WsD.Range("F" & n + 2) = Tong Else WsD.Range("G" & n + 2) = Abs(Tong)
    If n > 10 Then Call LineDot(WsD.Range("A11:G" & n))
    Call LineThin(WsD.Range("A" & n + 1 & ":G" & n + 2))
    Exit Sub
    Application.ScreenUpdating = True
Thoat:
    Exit Sub
End Sub


Mã:
Private Function LineDot(Rng As Range)
    With Rng
        .Borders(xlEdgeLeft).LineStyle = xlContinuous
        .Borders(xlEdgeRight).LineStyle = xlContinuous
        .Borders(xlEdgeBottom).LineStyle = xlContinuous
        .Borders(xlEdgeTop).LineStyle = xlContinuous
        .Borders(xlInsideVertical).LineStyle = xlContinuous
        .Borders(xlInsideHorizontal).LineStyle = xlDot
    End With
End Function

Mã:
Private Function LineThin(Rng As Range)
    With Rng
        .Borders(xlEdgeLeft).LineStyle = xlContinuous
        .Borders(xlEdgeRight).LineStyle = xlContinuous
        .Borders(xlEdgeBottom).LineStyle = xlContinuous
        .Borders(xlEdgeTop).LineStyle = xlContinuous
        .Borders(xlInsideVertical).LineStyle = xlContinuous
        .Borders(xlInsideHorizontal).LineStyle = xlContinuous
    End With
End Function[/U]
Các bạn giúp mình giải thích code từ đoạn (For I = 9 To m) mình đã đánh dấu gạch chân. Mình cảm ơn
 
Lần chỉnh sửa cuối:
Upvote 0
Nếu là mình, mình sẽ làm như vầy:

PHP:
 Option Explicit
 Dim wNK As Worksheet, wSC As Worksheet
 Dim DCnk As Long, DCsc As Long, I As Long, J As Long
Sub LocForNext()
 Dim TK, Vung As Range, Tong As Double
 Application.ScreenUpdating = False
 On Error GoTo Thoat
 Set wNK = Worksheets("NKC"):       Set wSC = Worksheets("SOCAI")
 Set Vung = wSC.Range("A1:B3")
 DCnk = wNK.Range("D65000").End(xlUp).Row
 DCsc = wSC.Range("D65000").End(xlUp).Row
 TK = wSC.Range("D5").Value
'Xóa Du Lieu Cu Cua SOCAI:'
 If DCsc > 10 Then wSC.Range("A11:G" & DCsc).Clear
'Dùng Vòng Lap De Gán Du Lieu:'
1    For I = 9 To DCnk
        If wNK.Range("F" & I) = TK Then 'Duyet Các Cot Trong So Cái'
3            DCsc = wSC.Range("D65000").End(xlUp).Row
            wNK.Range("B" & I & ":E" & I).Copy Destination:=wSC.Range("A" & DCsc + 1)
5            wSC.Range("E" & DCsc + 1) = wNK.Range("G" & I)
            wSC.Range("F" & DCsc + 1) = wNK.Range("H" & I)
7        ElseIf wNK.Range("G" & I) = TK Then
            DCsc = wSC.Range("D65000").End(xlUp).Row
9            wNK.Range("B" & I & ":E" & I).Copy Destination:=wSC.Range("A" & DCsc + 1)
            wSC.Range("E" & DCsc + 1) = wNK.Range("F" & I)
11            wSC.Range("G" & DCsc + 1) = wNK.Range("H" & I)
        End If
13    Next I
    DCsc = wSC.Range("D65000").End(xlUp).Row
15    wSC.Range("A11:G" & DCsc + 2).Font.Size = 8
    wSC.Range("F11:G" & DCsc + 2).NumberFormat = "#,##0"
17    wSC.Range("D" & DCsc + 1) = wSC.Range("D1")
    wSC.Range("D" & DCsc + 2) = wSC.Range("D2")
19    wSC.Range("F" & DCsc + 1 & ":G" & DCsc + 1).Formula = "=SUM(R11C:R" & DCsc & "C)"
    wSC.Range("F" & DCsc + 1 & ":G" & DCsc + 1).Value = _
        wSC.Range("F" & DCsc + 1 & ":G" & DCsc + 1).Value
21    Tong = wSC.Range("F10") - wSC.Range("G10") + wSC.Range("F" & DCsc + 1) - wSC.Range("G" & DCsc + 1)
    If Tong > 0 Then
23        wSC.Range("F" & DCsc + 2) = Tong
    Else
25        wSC.Range("G" & DCsc + 2) = Abs(Tong)
    End If
27    If DCsc > 10 Then Call LineDot(wSC.Range("A11:G" & DCsc))
    Call LineThin(wSC.Range("A" & DCsc + 1 & ":G" & DCsc + 2))
29    Exit Sub
    Application.ScreenUpdating = True
Thoat:
31    Exit Sub
End Sub

(*) Bạn thấy mình khai báo các biến wNK & wSC có gợi nhớ hơn không?
(*) Để giải thích cho dòng lệnh dưới, ta nên có dấu ':' ở cuối dòng
(**) Trong macro của bạn, biến n được bạn giải thích là số dòng đếm được ;

Nhưng như vậy dòng lệnh mang số 2 (giữa 1 & 3) có vấn đề rồi; Bạn nên nói rõ í đồ của mình chỗ này; Lúc đó chúng ta mới tiếp được;

(***) Bạn không nên gọi 2 hàm, theo mình nên gọi 2 Sub & truyền cho chúng tham số thích hợp;

Cũng theo mình, 2 Sub này chỉ nên viết làm 1 với thêm 1 tham biến nữa mà thôi; Tuy nhiên cái này hạ hồi phân giải.

Chờ tin từ bạn.
 
Lần chỉnh sửa cuối:
Upvote 0
Tôi đang tìm hiểu về mảng, tôi tạo Code như thế này nhưng không chạy được, vậy nó sai ở đâu?

PHP:
Sub Loc()
    Dim sArr(), Arr(), i As Long, j As Long
    j = 1
    For i = 1 To 4
        sArr = Sheet1.Range("A" & i & ":C" & i).Value
        Arr = Sheet1.Range("F" & j & ":H" & j).Value
        Arr = sArr
        j = j + 1
    Next
    Sheet1.[F2].Resize(j).Value = Arr
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
Mình chưa hiểu yêu cầu bạn định làm với code trên như thế nào? CODE của bạn không phải k chạy mà là chạy chưa đúng yêu cầu bạn muốn làm??? Phải chẳng bạn muốn xoay Arr 90 độ khi gán xuống sheet??? Bạn có thể thay câu lệnh này :
Sheet1.[F2].Resize(j).Value = Arr
bằng câu này xem sao :
Sheet1.[F2].Resize(j).Value = Application.WorksheetFunction.Transpose(Arr)
Thanks!
 
Upvote 0
Tôi đang tìm hiểu về mảng, tôi tạo Code như thế này nhưng không chạy được, vậy nó sai ở đâu?

PHP:
Sub Loc()
    Dim sArr(), Arr(), i As Long, j As Long
    j = 1
    For i = 1 To 4
        sArr = Sheet1.Range("A" & i & ":C" & i).Value
        Arr = Sheet1.Range("F" & j & ":H" & j).Value
        Arr = sArr
        j = j + 1
    Next
    Sheet1.[F2].Resize(j).Value = Arr
End Sub

Không hiểu bạn tính làm gì, sao bạn gán chi nhiều vậy, theo cách bạn gán chắc viết gọn lại là
PHP:
Sub Loc()
    Dim sArr(), Arr(), i As Long, j As Long
    j = 5
    Arr = Sheet1.Range("A4:C4").Value
    Sheet1.[J2].Resize(j).Value = WorksheetFunction.Transpose(Arr)
End Sub
Mà vẫn chưa hiểu bạn muốn làm gì?
 
Lần chỉnh sửa cuối:
Upvote 0
Thực chất tôi thử lệnh cú pháp của mảng: Copy đoạn A1:C4 xuống đoạn F1:H4 ấy mà. Nói cách khác [A1:C4]=[F1:H4]
 
Upvote 0
Thực chất tôi thử lệnh cú pháp của mảng: Copy đoạn A1:C4 xuống đoạn F1:H4 ấy mà. Nói cách khác [A1:C4]=[F1:H4]
Trời, chỉ copy thôi mà FOR dữ vậy, bạn chỉ cần thế này thôi :
PHP:
Sub Loc()
With Sheet1
    .[A1:C4].Copy .[F1:H4]
End With
End Sub
Nếu tư duy để làm như bạn thì nó chạy đến i = 4 và nó gán luôn
[A4:C4] = [F4:H4] và và sArr lúc đó sẽ chỉ là [A4:C4].value (nếu
viết tường tận ra) vòng lặp dừng ở đây sau đó đổ ra sheet sao mà lấy được từ i =1 nữa trời.
 
Upvote 0
Trời, chỉ copy thôi mà FOR dữ vậy, bạn chỉ cần thế này thôi :
PHP:
Sub Loc()
With Sheet1
    .[A1:C4].Copy .[F1:H4]
End With
End Sub
Nếu tư duy để làm như bạn thì nó chạy đến i = 4 và nó gán luôn
[A4:C4] = [F4:H4] và và sArr lúc đó sẽ chỉ là [A4:C4].value (nếu
viết tường tận ra) vòng lặp dừng ở đây sau đó đổ ra sheet sao mà lấy được từ i =1 nữa trời.
Code theo phương pháp xử lý mảng nó phải như vầy:
PHP:
Sub Loc()
  With Sheet1
    .Range("F1:H4").Value = .Range("A1:C4").Value
  End With
End Sub
Hoặc kỹ 1 chút:
PHP:
Sub Loc()
  Dim sArray
  sArray = Sheet1.Range("A1:C4").Value
  Sheet1.Range("F1:H4").Value = Arr
End Sub
 
Upvote 0
Sao tôi viết Code Copy cả 2 dạng đều không được nhỉ

PHP:
Sub Macro1()
    Range("C3").Copy
    Range("A7").Paste
End Sub

PHP:
Sub Copy()
Range("C3").Copy Destination:=Range("A7")
End Sub
 
Upvote 0
Sao tôi viết Code Copy cả 2 dạng đều không được nhỉ

PHP:
Sub Macro1()
    Range("C3").Copy
    Range("A7").Paste
End Sub

PHP:
Sub Copy()
Range("C3").Copy Destination:=Range("A7")
End Sub
Cách 1 sửa như sau:
PHP:
Sub Macro1()
    Range("C3").Copy Range("A7")
End Sub
Cách 2 chạy bình thường
 
Upvote 0
Nếu cách 1 viết gọn thế thì cần gì phải thêm cái thằng Destination cho dài dòng nhỉ?
 
Upvote 0
Nếu cách 1 viết gọn thế thì cần gì phải thêm cái thằng Destination cho dài dòng nhỉ?
Đó cũng là cách viết gọn thôi cũng như 2 cách viết dưới đây như nhâu vậy:
Mã:
        Set Rng = Sh.Cells.Find(n.name, Sh.[A1], xlFormulas, 2)
        Set Rng = Sh.Cells.Find(what:=n.name, after:=Sh.[A1], LookIn:=xlFormulas, Lookat:=2)
 
Upvote 0
Em chưa hiểu Code sau nhầm ở điểm gì mà không chạy được, rất mong mọi người chỉ giúp

PHP:
Sub Ktra()
    Dim sArr, DL()
    With Sheet1.Range("A1").CurrentRegion.Offset(1, 1)
        sArr = .Resize(.Rows.Count - 1, .Columns.Count - 1)
        DL = sArr.Value
    End With
    MsgBox UBound(DL, 1)
End Sub
 
Upvote 0
Em chưa hiểu Code sau nhầm ở điểm gì mà không chạy được, rất mong mọi người chỉ giúp

PHP:
Sub Ktra()
    Dim sArr, DL()
    With Sheet1.Range("A1").CurrentRegion.Offset(1, 1)
        sArr = .Resize(.Rows.Count - 1, .Columns.Count - 1)
        DL = sArr.Value
    End With
    MsgBox UBound(DL, 1)
End Sub
Bạn ghi sArr = .Resize(.Rows.Count - 1, .Columns.Count - 1) thì sArr sẽ là 1 mảng ---> Vậy thì câu DL = sArr.Value là sai (mảng không có thuộc tính Value)
Nếu sửa thành:
Mã:
Sub Ktra()
  Dim sArr, DL()
  With Sheet1.Range("A1").CurrentRegion.Offset(1, 1)
    [COLOR=#ff0000][B]Set[/B][/COLOR] sArr = .Resize(.Rows.Count - 1, .Columns.Count - 1)
    DL = sArr.Value
  End With
  MsgBox UBound(DL, 1)
End Sub
hoặc vầy:
Mã:
Sub Ktra()
  Dim sArr, DL()
  With Sheet1.Range("A1").CurrentRegion.Offset(1, 1)
    [B][COLOR=#ff0000]sArr = .Resize(.Rows.Count - 1, .Columns.Count - 1)
    DL = sArr[/COLOR][/B]
  End With
  MsgBox UBound(DL, 1)
End Sub
Sẽ không có vấn đề
 
Upvote 0
Nhờ các bạn sửa dùm Code

Tôi loay hoay quá, ngồi sửa mãi mà nó cứ màu đỏ hoài, nhờ các bác sửa giúp

PHP:
Sub Thunghiem()
    Dim i As Long, Dongcuoi As Long, k As Long
    Dongcuoi = Sheet1.Range("B65000").End(xlUp).Row
    With Sheet1
        For i = 1 To Dongcuoi
            If Cells(i, 1) <> "" Then
                k = i
                Cells(k, 2).Formula = "=sum(R[-1]C:R" & "-["i-k"])C"
            End If
        Next
    End With
End Sub
 
Upvote 0
Tôi loay hoay quá, ngồi sửa mãi mà nó cứ màu đỏ hoài, nhờ các bác sửa giúp

PHP:
Sub Thunghiem()
    Dim i As Long, Dongcuoi As Long, k As Long
    Dongcuoi = Sheet1.Range("B65000").End(xlUp).Row
    With Sheet1
        For i = 1 To Dongcuoi
            If Cells(i, 1) <> "" Then
                k = i
                Cells(k, 2).Formula = "=sum(R[-1]C:R" & "-["i-k"])C"
            End If
        Next
    End With
End Sub
Viết vầy mới đúng cú pháp Cells(k, 2).Value ="sum(R[-1]C:R" & i-k & "C)"
Có điều k = i nên i - k sẽ = 0
i chạy từ 1, vậy R[-1] là dòng 0 à?
---> Vậy sao được chứ?
Cuối cùng bạn đang muốn tính cái gì đây?
 
Upvote 0
Tôi muốn thực tập viết cú pháp cho quen, bài toán tôi định làm là tính tổng thành phần thày ah, kính nhờ thày giúp cho
PHP:
Sub Thunghiem()
    Dim i As Long, Dongcuoi As Long, k As Long
    Dongcuoi = Sheet1.Range("B65000").End(xlUp).Row
    With Sheet1
        For i = 1 To Dongcuoi
            If Cells(i, 1) <> "" Then
                k = i
                Cells(k, 2).Value = "sum(R[-1]C:R" & i - k & "C)"
            End If
        Next
    End With
End Sub
 

File đính kèm

Upvote 0
Tôi muốn thực tập viết cú pháp cho quen, bài toán tôi định làm là tính tổng thành phần thày ah, kính nhờ thày giúp cho
PHP:
Sub Thunghiem()
    Dim i As Long, Dongcuoi As Long, k As Long
    Dongcuoi = Sheet1.Range("B65000").End(xlUp).Row
    With Sheet1
        For i = 1 To Dongcuoi
            If Cells(i, 1) <> "" Then
                k = i
                Cells(k, 2).Value = "sum(R[-1]C:R" & i - k & "C)"
            End If
        Next
    End With
End Sub
Vầy mới đúng:
PHP:
Sub Thunghiem()
  Dim i As Long, Dongcuoi As Long, k As Long
  Dongcuoi = Sheet1.Range("B65000").End(xlUp).Row
  k = Dongcuoi + 1
  With Sheet1
    For i = Dongcuoi To 1 Step -1
      If .Cells(i, 1).Value <> "" Then
        .Cells(i, 2).Value = "=sum(R" & k - 1 & "C:R" & i + 1 & "C)"
        k = i
      End If
    Next
  End With
End Sub
Cộng dồn phải For ngược từ dưới lên bạn à!
Ngoài ra bạn ghi With Sheet1 ở trên nhưng bên trong chẳng có gì liên quan đến Sheet1, sao mà được chứ?
 
Upvote 0
hoặc thế này cũng được, nếu đi từ trên xuống dưới
PHP:
Sub Thunghiem()
    Dim i As Long, Dongcuoi As Long, k As Long
    Dongcuoi = Sheet1.Range("B65000").End(xlUp).Row
    With Sheet1
        For i = 1 To Dongcuoi
            If .Cells(i, 1) <> "" Then
                k = i
            Else
                .Cells(k, 2).Value = "=SUM(R[1]C:R[" & (i - k) & "]C)"
            End If
        Next
    End With
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
Tôi muốn thực tập viết cú pháp cho quen, bài toán tôi định làm là tính tổng thành phần thày ah, kính nhờ thày giúp cho
PHP:
Sub Thunghiem()
    Dim i As Long, Dongcuoi As Long, k As Long
    Dongcuoi = Sheet1.Range("B65000").End(xlUp).Row
    With Sheet1
        For i = 1 To Dongcuoi
            If Cells(i, 1) <> "" Then
                k = i
                Cells(k, 2).Value = "sum(R[-1]C:R" & i - k & "C)"
            End If
        Next
    End With
End Sub
Với dạng bài này bạn nên duyệt từ dưới lên trên. Thuật toán như thế này: Duyệt từ dưới lên trên, nếu ô ở cột A rỗng thì cho k tăng 1 đơn vị, nếu ô ở cột A không rỗng thì gán công thức vào ô của cột bên cạnh và cho k = 0. Cứ thế cho đến hết. Thêm 1 điều kiện nữa là khi nào k lớn hơn 0 (tức là có dòng để cộng) thì mới gán công thức.
PHP:
Sub Thunghiem()
    Dim i As Long, Dongcuoi As Long, k As Long
    Dongcuoi = Sheet1.Range("B65000").End(xlUp).Row
    With Sheet1
        For i = Dongcuoi To 1 Step -1
            If Cells(i, 1) = "" Then
                k = k + 1
            Else
                If k > 0 Then
                    Cells(i, 2).Value = "=sum(R[1]C:R[" & k & "]C)"
                    k = 0
                End If
            End If
        Next
    End With
End Sub
 
Upvote 0
hoặc thế này cũng được, nếu đi từ trên xuống dưới
PHP:
Sub Thunghiem()
    Dim i As Long, Dongcuoi As Long, k As Long
    Dongcuoi = Sheet1.Range("B65000").End(xlUp).Row
    With Sheet1
        For i = 1 To Dongcuoi
            If Cells(i, 1) <> "" Then
                k = i
            Else
                Cells(k, 2).Value = "=SUM(R[1]C:R[" & (i - k) & "]C)"
            End If
        Next
    End With
End Sub
Đương nhiên được nhưng tốc độ sẽ chậm hơn vì code phải làm việc nhiều hơn!
Bấm F8 theo dỏi code sẽ rõ điều này
 
Upvote 0
Cách giải trên chỉ mang tính tham khảo thôi, tối ưu nhất vẫn là đi từ dưới lên trên như thày Ndu và bác Huuthang-bd làm.

Bạn lưu ý: 1 số bài toán khác như thêm bớt dòng đi từ trên xuống dưới sẽ không chính xác.
 
Upvote 0
Sao tôi chạy Code của thày Ndu, nó lại tham chiếu tuyệt đối (=SUM(B$2:B$4)) mà không phải là tương đối
PHP:
Sub Thunghiem()
    Dim i As Long, Dongcuoi As Long, k As Long
    Dongcuoi = Sheet1.Range("B65000").End(xlUp).Row
    k = Dongcuoi + 1
    With Sheet1
        For i = Dongcuoi To 1 Step -1
            If .Cells(i, 1).Value <> "" Then
                .Cells(i, 2).Value = "=sum(R" & k - 1 & "C:R" & i + 1 & "C)"
                k = i
            End If
        Next
    End With
End Sub

Xin thày cho hỏi làm thế nào để chuyển tham chiếu tuyệt đối sang tương đối tức (=SUM(B$2:B$4) thành =SUM(B2:B4))
 
Upvote 0
Sao tôi chạy Code của thày Ndu, nó lại tham chiếu tuyệt đối (=SUM(B$2:B$4)) mà không phải là tương đối
PHP:
Sub Thunghiem()
    Dim i As Long, Dongcuoi As Long, k As Long
    Dongcuoi = Sheet1.Range("B65000").End(xlUp).Row
    k = Dongcuoi + 1
    With Sheet1
        For i = Dongcuoi To 1 Step -1
            If .Cells(i, 1).Value <> "" Then
                .Cells(i, 2).Value = "=sum(R" & k - 1 & "C:R" & i + 1 & "C)"
                k = i
            End If
        Next
    End With
End Sub

Xin thày cho hỏi làm thế nào để chuyển tham chiếu tuyệt đối sang tương đối tức (=SUM(B$2:B$4) thành =SUM(B2:B4))
Sửa vầy sẽ thành địa chỉ tương đối thôi: .Cells(i, 2).Value = "=SUM(R[1]C:R[" & k - i - 1 & "]C)"
 
Upvote 0
Sao lại thế nhỉ, nhìn 2 cái
PHP:
.Cells(i, 2).Value = "=sum(R" & k - 1 & "C:R" & i + 1 & "C)"

PHP:
.Cells(i, 2).Value = "=SUM(R[1]C:R[" & k - i - 1 & "]C)"

Đâu có gì khác nhau?


lạ quá, tôi làm thử thay đổi 2 dòng này cho kết quả khác nhau, xin thày dạy dùm
PHP:
.Cells(i, 2).Value = "=SUM(R[1]C:R[" & k - i - 1 & "]C)"
PHP:
.Cells(i, 2).Value = "=SUM(R1C:R" & k - i - 1 & "C)"
khác nhau như thế nào thày nhỉ?

Vậy, tác dụng của dấu ngoặc vuông ([]) ở đây đóng vai trò gì ?
-----------
Ah, tôi hiểu rồi dấu ngoặc vuông chính là biểu thị của sự tương đối, nếu không có nó biểu thị tuyệt đối (trước tôi cứ nghĩ nó chỉ là dấu đóng mở ngoặc thôi).

Nhờ có bài của thày Ndu mà tôi biết về điều tưởng đơn giản này, cảm ơn thày rất nhiều.
 
Lần chỉnh sửa cuối:
Upvote 0
Sao lại thế nhỉ, nhìn 2 cái
PHP:
.Cells(i, 2).Value = "=sum(R" & k - 1 & "C:R" & i + 1 & "C)"

PHP:
.Cells(i, 2).Value = "=SUM(R[1]C:R[" & k - i - 1 & "]C)"

Đâu có gì khác nhau?
Khác nhau ở chổ: 1 thằng có cặp dấu [] còn thằng kia thì không có
Vậy thôi!
Nếu ghi R1, nghĩa là bạn chỉ chính xác đấy là dòng 1
Nếu ghi R[1], nghĩa là nó mang tính tương đối, cách dòng đang xét 1 dòng
 
Upvote 0
Tôi cộng tổng thêm 1 cấp độ nữa, code tôi viết như sau:

PHP:
Sub Tinhtong()
    Dim i As Long, kk As Long, eR As Long, stotal As String
    eR = Range("C65000").End(xlUp).Row
    kk = eR + 1
    For i = eR To 1 Step -1
        If Cells(i, 2) <> "" Then
            Cells(i, 3) = "=sum(R[1]C:R[" & kk - i - 1 & "]C)"
            stotal = stotal + "+" + Cells(i, 3)
        ElseIf Cells(i, 1) <> "" Then
            Cell(i, 3) = "=" & Right(stotal, Len(stotal) - 1) & ")"
            kk = i
        End If
    Next
End Sub

Nhờ thày tư vấn thêm giúp cho làm sao Code chạy đúng
 

File đính kèm

Upvote 0
Tôi cộng tổng thêm 1 cấp độ nữa, code tôi viết như sau:

PHP:
Sub Tinhtong()
    Dim i As Long, kk As Long, eR As Long, stotal As String
    eR = Range("C65000").End(xlUp).Row
    kk = eR + 1
    For i = eR To 1 Step -1
        If Cells(i, 2) <> "" Then
            Cells(i, 3) = "=sum(R[1]C:R[" & kk - i - 1 & "]C)"
            stotal = stotal + "+" + Cells(i, 3)
        ElseIf Cells(i, 1) <> "" Then
            Cell(i, 3) = "=" & Right(stotal, Len(stotal) - 1) & ")"
            kk = i
        End If
    Next
End Sub

Nhờ thày tư vấn thêm giúp cho làm sao Code chạy đúng
Nếu cộng dồn mà ra kết quả luôn, ta dùng code cũng không nói làm gì... Ở đây, đằng nào cũng viết công thức, vậy sao bạn không viết trực tiếp vào bảng tính luôn
Nếu là tôi thì tôi sẽ làm bài này như sau:
- Quét chọn vùng dữ liệu, chọn AutoFilter
- Filter cột B theo điều kiện Non Blanks
- Quét chọn cột C, từ dòng 2 trở đi rồi gõ vào thanh Formula công thưc: =SUBTOTAL(109,$C3:$C$1000)-SUMIF($B3:$B$1000,"<>",$C3:$C$1000) rồi bấm Ctrl + Enter
- Show All cột B, chuyển sang Filter cột A theo điều kiện Non Blanks
- Quét chọn cột C, từ dòng 1 trở đi rồi gõ vào thanh Formula công thức: =SUBTOTAL(109,$C2:$C$1000)-SUMIF($A2:$A$1000,"<>",$C2:$C$1000) rồi bấm Ctrl + Enter
- Huy chế độ AutoFilter, có ngay kết quả
------------------
Làm ra kết quả trong vòng tích tắc... Nếu muốn viết code, bạn cứ dựa vào 2 công thức ở trên mà viết cho khỏe
 

File đính kèm

Upvote 0
Cảm ơn thày tôi đang cố gắng tiếp cận VBA từng bước một, phiền thày và mọi người hoàn thiện Code trên giúp.

(Bài này tôi làm với tính chất nghiên cứu chứ chưa phải bài toán thực tế)
 
Upvote 0
Xin mọi người giải thích giùm em đoạn code này với: Trong userform có một combobox. Muốn gán dữ liệu vào combobox này nhưng em không hiểu sub này làm việc như thế nào ạ!!!
Private Sub usfhiep_Load()
Dim i As Byte
For i = 0 To 11
Me.cbopt.List(i) = i + 1
Next
Me.cbopt.ListIndex = 0
End Sub
 
Upvote 0
Kính nhờ thày Ndu và mọi người giúp tôi sửa lại Code bài 1079 ở trên với, tôi đang rất cần học thuật toán về VBA

Xin được trích dẫn lại Code cần trợ giúp

PHP:
Sub Tinhtong()
    Dim i As Long, kk As Long, eR As Long, stotal As String
    eR = Range("C65000").End(xlUp).Row
    kk = eR + 1
    For i = eR To 1 Step -1
        If Cells(i, 2) <> "" Then
            Cells(i, 3) = "=sum(R[1]C:R[" & kk - i - 1 & "]C)"
            stotal = stotal + "+" + Cells(i, 3)
        ElseIf Cells(i, 1) <> "" Then
            Cell(i, 3) = "=" & Right(stotal, Len(stotal) - 1) & ")"
            kk = i
        End If
    Next
End Sub
Xin cảm ơn rất nhiều
 
Upvote 0
Kính nhờ thày Ndu và mọi người giúp tôi sửa lại Code bài 1079 ở trên với, tôi đang rất cần học thuật toán về VBA

Xin được trích dẫn lại Code cần trợ giúp

PHP:
Sub Tinhtong()
    Dim i As Long, kk As Long, eR As Long, stotal As String
    eR = Range("C65000").End(xlUp).Row
    kk = eR + 1
    For i = eR To 1 Step -1
        If Cells(i, 2) <> "" Then
            Cells(i, 3) = "=sum(R[1]C:R[" & kk - i - 1 & "]C)"
            stotal = stotal + "+" + Cells(i, 3)
        ElseIf Cells(i, 1) <> "" Then
            Cell(i, 3) = "=" & Right(stotal, Len(stotal) - 1) & ")"
            kk = i
        End If
    Next
End Sub
Xin cảm ơn rất nhiều
Tôi không biết "ý đồ" của bạn là đưa công thức vào làm gì nên không bàn.
Tôi chỉ làm thử bằng cách gán giá trị vào luôn.
PHP:
Sub Tinhtong()
    Dim i As Long, eR As Long, Tem1 As Double, Tem2 As Double
    eR = Range("C65000").End(xlUp).Row
    For i = eR To 1 Step -1
        If Cells(i, 1) = "" Then
            If Cells(i, 2) = "" Then
                Tem1 = Tem1 + Cells(i, 3)
                Tem2 = Tem2 + Cells(i, 3)
            Else
                Cells(i, 3) = Tem1
                Tem1 = 0
            End If
        Else
            Cells(i, 3) = Tem2
            Tem2 = 0
        End If
    Next i
End Sub
 

File đính kèm

Upvote 0
Kính nhờ thày Ndu và mọi người giúp tôi sửa lại Code bài 1079 ở trên với, tôi đang rất cần học thuật toán về VBA

Xin được trích dẫn lại Code cần trợ giúp

PHP:
Sub Tinhtong()
    Dim i As Long, kk As Long, eR As Long, stotal As String
    eR = Range("C65000").End(xlUp).Row
    kk = eR + 1
    For i = eR To 1 Step -1
        If Cells(i, 2) <> "" Then
            Cells(i, 3) = "=sum(R[1]C:R[" & kk - i - 1 & "]C)"
            stotal = stotal + "+" + Cells(i, 3)
        ElseIf Cells(i, 1) <> "" Then
            Cell(i, 3) = "=" & Right(stotal, Len(stotal) - 1) & ")"
            kk = i
        End If
    Next
End Sub
Xin cảm ơn rất nhiều
Sửa thành vầy xem:
PHP:
Sub TinhTong()
  Dim i As Long, Dongcuoi As Long, k As Long, n As Long, Arr()
  Dongcuoi = Sheet1.Range("C65000").End(xlUp).Row
  ReDim Arr(1 To 1)
  k = Dongcuoi
  With Sheet1
    For i = Dongcuoi To 1 Step -1
      If .Cells(i, 2).Value <> "" And .Cells(i, 1) = "" Then
        .Cells(i, 3).Value = "=SUM(R[1]C:R[" & k - i & "]C)"
        k = i - 1: n = n + 1
        ReDim Preserve Arr(1 To n)
        Arr(n) = .Cells(i, 3).Address(0, 0)
      ElseIf .Cells(i, 1) <> "" Then
        k = i - 1: n = 0
        .Cells(i, 3).Value = "=" & Join(Arr, "+")
        ReDim Arr(1 To 1)
      End If
    Next
  End With
End Sub
 
Upvote 0
Cảm ơn thày Ndu và bác Ba Tê rất nhiều, làm theo cách của bác Ba Tê tôi đã tham khảo trên diễn đàn. Tuy nhiên sự cần thiết phải hiện ra công thức trong thực tế là có;

Tôi biết làm theo mảng vẫn là số 1 về tốc độ, tuy vậy trong thực tế đôi khi cần gửi cho đối tác và Sếp thì điều quan trọng nhất là tính kiểm tra được bằng những công thức đơn giản nhất mà người dùng Excel trình độ A, B cũng có thể biết. Tôi đã làm theo 2 cách mà không được chấp thuận tại cơ quan:

Cách 1: làm bằng mảng như của bác Ba Tê, thì sếp bảo: Làm thế làm không có sự liên kết giữa đầu vào và đầu ra thì làm sao kiểm tra được ---> tốt nhất là quay lại chịu khó Sum bằng tay.

Cách 2: Khi quay sang dùng công thức Excel (phối hợp các hàm Vlookup, Index..) để giải quyết thì sếp lại bảo chỉ được dùng hàm thông dụng, dễ hiểu nhất như Sum ... dùng công thức phức tạp rối mắt thế người khác không hiểu được.

Tôi vẫn biết đối với việc dùng Code mà vẫn bắt hiện ra công thức vừa làm chậm tốc độ, viết Code sẽ loằng ngoằng hơn đôi khi chính bản thân tôi cũng không thích, nhưng đúng là với 1 số cơ quan để giải quyết công việc thì bắt buộc vẫn phải làm vậy (vì làm 2 cách trên Sếp không chấp thuận).
 
Lần chỉnh sửa cuối:
Upvote 0
Xin được trích dẫn lại Code cần trợ giúp
Mã:
[B]Sub Tinhtong()[/B]
    Dim i As Long, kk As Long, eR As Long, stotal As String
    eR = Range("C65000").End(xlUp).Row
    kk = eR + 1
    For i = eR To 1 Step -1
        If Cells(i, 2) <> "" Then
            Cells(i, 3) = "=sum(R[1]C:R[" & kk - i - 1 & "]C)"
7            stotal = stotal + "+" + Cells(i, 3)
        ElseIf Cells(i, 1) <> "" Then
9            Cell(i, 3) = "=" & Right(stotal, Len(stotal) - 1) & ")"
            kk = i
        End If
    Next
[B]End Sub[/B]

Dòng lệnh 9 đang sai 2 chỗ

(+) 1 ô là 1 tập hợp, chứ không fải 1 fần tử, nên fải viết là Cells(i, 3);
(+) Vế sau chứng tỏ bạn muốn gán công thức vô ô này, Vậy là bạn fải làm cho máy hiểu là tôi sẽ xài fương thức .Formula

Dòng lệnh 7 đang sai với lí do bạn đang cố bắt máy nối số liệu vô chuỗi; Chuyện này nó không chịu;

Chí ít fải là: stotal = stotal + "+" + CStr(Cells(i, 3)) ;
Tuy nhiên như vậy sẽ dẫn đến lại sai dòng lệnh 9 ở 1 chuyện khác;

Mình xin khuyên bạn thêm vài điều:


(-) Ta nên khai tên biến là sTotal (thay vì stotal)

(-) Khi nối chuỗi ta nên dùng toán tử '&' (thay vì '+'), tuy rằng không ai cấm, cũng như chả ai fạt bạn chuyện đi 1 chưn trên hè, 1 cẳng dưới lòng đường.

(-) Tường minh hơn khi viết: stotal = stotal + "+" + Cells(i, 3).Value
(thay vì stotal = stotal + "+" + Cells(i, 3))

Có khi nào bạn ra lệnh cho con hay ai đó: "Lấy quyễn sách 900 trang đưa tau"
hay câu "Lấy quyễn từ điển Hán - Nôm đưa tau"

Thân ái!
 
Lần chỉnh sửa cuối:
Upvote 0
Cảm ơn thày Ndu và bác Ba Tê rất nhiều, làm theo cách của bác Ba Tê tôi đã tham khảo trên diễn đàn. Tuy nhiên sự cần thiết phải hiện ra công thức trong thực tế là rất cần thiết;

Tôi biết làm theo mảng vẫn là số 1 về tốc độ, tuy vậy trong thực tế đôi khi cần gửi cho đối tác và Sếp thì điều quan trọng nhất là tính kiểm tra được bằng những công thức đơn giản nhất mà người dùng Excel trình độ A, B cũng có thể biết. Tôi đã làm theo 2 cách mà không được chấp thuận tại cơ quan:

Cách 1: làm bằng mảng như của bác Ba Tê, thì sếp bảo: Làm thế làm không có sự liên kết giữa đầu vào và đầu ra thì làm sao kiểm tra được ---> tốt nhất là quay lại chịu khó Sum bằng tay.

Cách 2: Khi quay sang dùng công thức Excel (phối hợp các hàm Vlookup, Index..) để giải quyết thì sếp lại bảo chỉ được dùng hàm thông dụng, dễ hiểu nhất như Sum ... dùng công thức phức tạp rối mắt thế người khác không hiểu được.

Tôi vẫn biết đối với việc dùng Code mà vẫn bắt hiện ra công thức vừa làm chậm tốc độ, viết Code sẽ loằng ngoằng hơn đôi khi chính bản thân tôi cũng không thích, nhưng đúng là với 1 số cơ quan để giải quyết công việc thì bắt buộc vẫn phải làm vậy (vì làm 2 cách trên Sếp không chấp thuận).
Cái khó là ở chổ đó... Gán Value vào cell là quá dễ, nếu chèn công thức thì phải "nhớ" chính xác vị trí của khối cell cần chèn vào công thức
------------------------
Bởi vậy, tại phòng làm việc của tôi luôn có 1 bảng ghi nhớ to tổ bố:
- ĐIỀU 1: SẾP LUÔN LUÔN ĐÚNG
- ĐIỀU 2: NẾU NGHI NGỜ RẰNG SẾP SAI, HÃY ĐỌC KỸ ĐIỀU 1

Ẹc... Ẹc... +-+-+-+ +-+-+-+ +-+-+-+ Đập đầu 3 cái để chứng tỏ rằng TA lúc nào cũng ngu hơn SẾP
 
Upvote 0
Đọc các giải, nhận xét của thày tôi thấy thực sự rất bổ ích, những lời dạy đó tôi sẽ tiếp thu để các bài sau sửa chữa
Thú thực câu lệnh

PHP:
 stotal = stotal + "+" + Cells(i, 3).Value

tôi học trên diễn đàn nhưng bản thân không hiểu lắm tại sao lại có tận 3 dấu cộng. Xin phiền các thày chỉ dạy thêm

Đa tạ các thày rất nhiều (bấm nút cảm ơn thấy còn chưa đủ nói hết sự biết ơn của bản thân đối với công lao của các thày).
 
Upvote 0
Đọc các giải, nhận xét của thày tôi thấy thực sự rất bổ ích, những lời dạy đó tôi sẽ tiếp thu để các bài sau sửa chữa
Thú thực câu lệnh

PHP:
 stotal = stotal + "+" + Cells(i, 3).Value

tôi học trên diễn đàn nhưng bản thân không hiểu lắm tại sao lại có tận 3 dấu cộng. Xin phiền các thày chỉ dạy thêm

Đa tạ các thày rất nhiều (bấm nút cảm ơn thấy còn chưa đủ nói hết sự biết ơn của bản thân đối với công lao của các thày).
Theo cách biểu diễn của code, ta có thể ngầm hiểu dấu + bên trái và bên phải tương đương với dấu &
(Nối chuổi trong VBA, dấu + tương đương dấu &)
Ví dụ: MsgBox "Hello" + " " + "World"
 
Upvote 0
Đọc các giải, nhận xét của thày tôi thấy thực sự rất bổ ích, những lời dạy đó tôi sẽ tiếp thu để các bài sau sửa chữa
Thú thực câu lệnh

PHP:
 stotal = stotal + "+" + Cells(i, 3).Value

tôi học trên diễn đàn nhưng bản thân không hiểu lắm tại sao lại có tận 3 dấu cộng. Xin phiền các thày chỉ dạy thêm

Đa tạ các thày rất nhiều (bấm nút cảm ơn thấy còn chưa đủ nói hết sự biết ơn của bản thân đối với công lao của các thày).
Nếu bạn viết thành:
PHP:
stotal = stotal & "+" & Cells(i, 3).Value
Bạn sẽ hiểu tại sao.
 
Upvote 0
Cách của thày Ndu sử dụng hàm Join rất hay, em chưa dùng nó bao giờ, thử nghĩ ra ví dụ để thực tập nhưng nó không được thày ah

PHP:
Sub gido()
Dim Arr()
Arr(0) = 2
Arr(1) = 5
Arr(2) = 10
Arr(3) = 11
Cells(1, 1) = "=" & Join(Arr, "+")
End Sub

Xin nhờ mọi người sửa giúp cho ah.
 
Upvote 0
Cách của thày Ndu sử dụng hàm Join rất hay, em chưa dùng nó bao giờ, thử nghĩ ra ví dụ để thực tập nhưng nó không được thày ah

PHP:
Sub gido()
Dim Arr()
Arr(0) = 2
Arr(1) = 5
Arr(2) = 10
Arr(3) = 11
Cells(1, 1) = "=" & Join(Arr, "+")
End Sub

Xin nhờ mọi người sửa giúp cho ah.
Thiếu đoạn khai báo kích thước của mảng nên không chạy là phải rồi
Mã:
Sub gido()
  Dim Arr()
 [COLOR=#ff0000][B] ReDim Arr(3)[/B][/COLOR]
  Arr(0) = 2
  Arr(1) = 5
  Arr(2) = 10
  Arr(3) = 11
  Cells(1, 1) = "=" & Join(Arr, "+")
End Sub
Hoặc khai báo trực tiếp từ đầu:
Mã:
Sub gido()
  [COLOR=#ff0000][B]Dim Arr(3)[/B][/COLOR]
  Arr(0) = 2
  Arr(1) = 5
  Arr(2) = 10
  Arr(3) = 11
  Cells(1, 1) = "=" & Join(Arr, "+")
End Sub
 
Upvote 0
Giúp em hiểu thêm về hàm Join

Em tìm hiểu về Join nhưng cú pháp câu cuối cùng (Cells(1, 3) = Join(Tmp1, Tmp2)) không biết phải sửa thế nào cho đúng, xin được nhờ các thày giúp đỡ

PHP:
Sub Connect()
    Dim sArr1, Tmp1(), sArr2, Tmp2(), i As Long, j As Long
    sArr1 = Range("A1:A10").Value
    sArr2 = Range("B1:B10").Value
    ReDim Tmp1(UBound(sArr1, 1) - 1)
    ReDim Tmp2(UBound(sArr2, 1) - 1)
    For i = 1 To UBound(sArr1, 1)
        Tmp1(i - 1) = sArr1(i, 1)
    Next
    For j = 1 To UBound(sArr2, 1)
        Tmp2(j - 1) = sArr2(j, 1)
    Next
    Cells(1, 3) = Join(Tmp1, Tmp2)
End Sub
 
Upvote 0
Em tìm hiểu về Join nhưng cú pháp câu cuối cùng (Cells(1, 3) = Join(Tmp1, Tmp2)) không biết phải sửa thế nào cho đúng, xin được nhờ các thày giúp đỡ

PHP:
Sub Connect()
    Dim sArr1, Tmp1(), sArr2, Tmp2(), i As Long, j As Long
    sArr1 = Range("A1:A10").Value
    sArr2 = Range("B1:B10").Value
    ReDim Tmp1(UBound(sArr1, 1) - 1)
    ReDim Tmp2(UBound(sArr2, 1) - 1)
    For i = 1 To UBound(sArr1, 1)
        Tmp1(i - 1) = sArr1(i, 1)
    Next
    For j = 1 To UBound(sArr2, 1)
        Tmp2(j - 1) = sArr2(j, 1)
    Next
    Cells(1, 3) = Join(Tmp1, Tmp2)
End Sub

Cú pháp hàm Join là Join(mảng, dấu phân cách)...
Còn bạn thì Join(Tmp1, Tmp2) với Tmp1, Tmp2 đều là mảng ---> Sao mà được!
Vậy bạn muốn làm gì đây? Mô tả vấn đề cho dễ hiểu nhé
 
Upvote 0
Em cứ tưởng là Join nó giống như Concatenate trong Excel, nghĩa là em cứ nghĩ ô C3 (tức Cells(1,3)) nó nối tất cả các phần tử của cả 2 mảng Tmp1 và Tmp2 vào với nhau

Em nghĩ có thể dùng được
Join(mang1, mang2)

Em chỉ thử nghiệm để biết cách dùng của Join thôi, em đang đi tìm hiểu những cái mới mà em chưa biết thày ah.
--------
Em đang tìm hiểu về Mid trong VBA em viết như trong Excel nhưng chưa được:

PHP:
Sub Tach()
    Dim sArr, Tmp(), sArr2, Tmp2(), i As Long, j As Long
    sArr = Range("A1:A10").Value
    ReDim Tmp(UBound(sArr, 1) - 1)
    For i = 1 To UBound(sArr, 1)
        Tmp(i - 1) = Mid(sArr(i, 1), 2, Len(sArr(i,1))
        n = n + 1
    Next
    [B1].Resize(n).Value = Tmp
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
Tôi có đôi chút thắc mắc về Code của thày Ndu, xin được mọi người chỉ bảo giúp tôi học hỏi thêm

1) Theo tôi thì thuộc tính mặc định của Range hoặc Cell trong các biểu thức ưu tiên sẽ là Value, như vậy việc bỏ Value đi có ảnh hưởng gì không?

2) Tôi thắc mắc là tại sao lại cần dòng ReDim Arr(1 to 1) ở dưới nhằm mục đích gì, vì tôi bỏ đi vẫn thấy nó đúng mà.

Tức là Code của thày Ndu:
PHP:
Sub TinhTong()
  Dim i As Long, Dongcuoi As Long, k As Long, n As Long, Arr()
  Dongcuoi = Sheet1.Range("C65000").End(xlUp).Row
  ReDim Arr(1 To 1)
  k = Dongcuoi
  With Sheet1
    For i = Dongcuoi To 1 Step -1
      If .Cells(i, 2).Value <> "" And .Cells(i, 1) = "" Then
        .Cells(i, 3).Value = "=SUM(R[1]C:R[" & k - i & "]C)"
        k = i - 1: n = n + 1
        ReDim Preserve Arr(1 To n)
        Arr(n) = .Cells(i, 3).Address(0, 0)
      ElseIf .Cells(i, 1) <> "" Then
        k = i - 1: n = 0
        .Cells(i, 3).Value = "=" & Join(Arr, "+")
        ReDim Arr(1 To 1)
      End If
    Next
  End With
End Sub

tôi sửa thành như vầy có được không?
PHP:
Sub Tinhtong()
    Dim i As Long, k As Long, n As Long, Dongcuoi As Long, Arr()
    Dongcuoi = Range("C65000").End(xlUp).Row
    k = Dongcuoi
    With Sheet1
        For i = Dongcuoi To 1 Step -1
            If .Cells(i, 2) <> "" And .Cells(i, 1) = "" Then
                .Cells(i, 3) = "=sum(R[1]:R[" & k - i & "]C)"
                k = i - 1
                n = n + 1
                ReDim Preserve Arr(1 To n)
                Arr(n) = .Cells(i, 3).Address(0, 0)
            ElseIf .Cells(i, 1) <> "" Then
                k = i - 1
                n = 0
                .Cells(i, 3) = "=" & Join(Arr, "+")
            End If
        Next
    End With
End Sub

--------
Tôi xin thắc mắc về cách viết cú pháp chút nữa:

Trong đoạn
PHP:
.Cells(i, 3).Value = "=SUM(R[1]C:R[" & k - i & "]C)"
thì dấu ) nằm trong "" (tức là "]C)").

Tại sao đoạn
PHP:
.Cells(i, 3) = "=" & Join(Arr, "+")
thì dấu ngoặc không "bị" nằm trong dấu "", mặc dù tôi thấy vai trò của nó như nhau.
 
Upvote 0
Status
Không mở trả lời sau này.

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

Back
Top Bottom