Chuyên đề giải đáp những thắc mắc về code VBA

Liên hệ QC

maytinhvp01

Thành viên thường trực
Tham gia
27/7/13
Bài viết
390
Được thích
179
Mình muốn nhờ giải thich câu lệnh " If Ran.Cells(d, c) > max Then max = Ran.Cells(d, c) "
trong ví du:
Public Function LonNhat(Ran As Range)
Dim max As Double, v As Integer, d As Integer, c As Integer
max = Ran.Cells(1, 1)
For d = 1 To Ran.Rows.Count
For c = 1 To Ran.Columns.Count
If Ran.Cells(d, c) > max Then max = Ran.Cells(d, c)
Next c
Next d
v = Tim(max, Ran)
LonNhat = max
End Function
-------------------------------------------------------
[INFO1]Thông báo:
Vì topic này:
http://www.giaiphapexcel.com/forum/...ải-thích-các-code-đề-nghị-các-bạn-gửi-vào-đây
đã quá dài nên BQT đóng lại.
Nay tôi mở topic mới với cùng chủ đề: GIẢI THÍCH NHỮNG THẮC MẮC VỀ CODE
Các bạn nếu có nhu cầu giải thích code, vui lòng post tại đây nhé
NDU96081631

[/INFO1]
 
Chỉnh sửa lần cuối bởi điều hành viên:
Như này à anh
VetMini
befaint

Mã:
Sub In_MaChonLoc()
    Dim sRng As Range, cell_ As Range
    Dim Ws As Worksheet
 
    On Error GoTo Thoat
    ActiveSheet.DisplayPageBreaks = False
    Set sRng = Application.InputBox(Prompt:="Chon Du lieu IN", Title:="Vung Data", Type:=8)
    For Each cell_ In sRng
        Set Ws = ActiveSheet
        With Ws
            .Range("AZ1").Value = cell_.Value
            .PrintOut 'Vung in Set
        End With
    Next cell_
Thoat:
End Sub
bạn thêm điều kiện vào rồi thỏa mãn thì goto ... cái gì đó ở dưới cùng bạn cho nó cái label như bác vietmini nói đấy
 
Upvote 0
bạn thêm điều kiện vào rồi thỏa mãn thì goto ... cái gì đó ở dưới cùng bạn cho nó cái label như bác vietmini nói đấy
Sub In_MaChonLoc_KL()
Dim sRng As Range, cell_ As Range
Dim Ws As Worksheet

On Error GoTo Thoat
ActiveSheet.DisplayPageBreaks = False
Set sRng = Application.InputBox(Prompt:="Chon Du lieu IN", Title:="Vung Data", Type:=8)
For Each cell_ In sRng
Set Ws = ActiveSheet
With Ws
If cell_ = 0 Then GoTo DiTiep
.Range("AZ1").Value = cell_.Value
Call HidedongProKL
.PrintOut 'Vung in Set
DiTiep:
End With
Next cell_
Thoat:
End Sub
như này đùng chưa anh nhỉ
 
Upvote 0
Cảnh giới về code ở bài #2784:

1. để thực hiện cách thức giống "Continue" ở các ngôn ngữ khác, cái label luôn luôn đặt ngay trước lệnh Next.
(code ở bài #2784 đặt nó cách Next một dòng End With. Đây là cách làm việc nguy hiểm)

2. dùng ký hiệu gạch dưới ( _ ) trong tên biến:
- Đặt giữa từ thì không sao. Đấy là một trong những cách ngăn từ cho dễ đọc. Ví dụ: s_totite
- Đặt trước hoặc sau từ thì có ý nghĩa khác. Thường thường người ta đặt trước tên biến để ngầm ý rằng đây là biến nội. Đối với lập trình hướng đối tượng, người ta thường đặt hai dấu gạch dưới trước tên biến (hoặc một dấu trước, một dấu sau) để phân biệt loại biến nội và không truyền sang các lớp con. Ví dụ: __totite, _totite_
Nói chung, ký tự gạch dưới đặt trước hoặc sau tên biến thường để đánh dấu loại biến đặc biệt nào đó.
 
Upvote 0
Anh đã đạt cảnh giới thượng thừa nào mà có thể cảnh báo (giới) về code vậy?
(hình như cảnh giới là danh từ)
Tôi lại nhầm rồi (*). Khi tôi nghĩ đến từ "giới" với nghĩa "răn" (诫, hoặc 戒) tôi ráp "cảnh" vào và quên mất khi hai từ này đi với nhau (境界) sẽ hiểu theo nghĩa khác.

(*) dạo này bị nhầm hơi nhiều. Cần tự "giới": xem lại nhiều lần trước khi pót :p :p :p
 
Upvote 0
Xin chào cả nhà, tôi có code sau, nó copy tất cả dữ liệu trong vùng "A1:C30" vào cột M.
Nhưng nó copy theo thứ tự A1-B1-C1-A2-B2-C2.... tôi muốn copy theo trình tự A1-A2-..-A30-B1-B2-...-B30-C1-...-C30 thì phải làm thế nào ạ

Sub copy()
Dim x As Range
For Each x In Range("A1:C30")
i = Range("m10000").End(xlUp).Row + 1
Range("M" & i) = x
Next x
End Sub
 
Upvote 0
copy theo trình tự A1-A2-..-A30-B1-B2-...-B30-C1-...-C30 thì phải làm
PHP:
Option Explicit

Sub copy_xxx()
Const rng = "A1:C30"
Const scell_target = "M1"
Dim data as variant, i as long, j as long, ub1 as long
Dim res as variant, ii as long
data = Range(rng).value2
ub1 = ubound(data, 1)
redim res(1 to Range(rng).cells.count, 1 to 1)
For j=1 to ubound(data, 2)
For i=1 to ub1
ii=ii+1
res(ii,1)=data(i,j)
Next i
Next j
Range(scell_target).res(1048500,1).clearcontents
Range(scell_target).resize(ii,1).value = res
End Sub
 
Upvote 0
1 cách cù lần nè
:
PHP:
Sub copyTheoCot()
Dim Cls As Range, Rng As Range
Dim J As Integer

For J = 1 To 3
    Set Rng = Cells(1, J).Resize(30)
    For Each Cls In Rng
        i = Range("m10000").End(xlUp).Row + 1
        Range("M" & i) = Cls.Value
        Range("M" & i).Interior.ColorIndex = 35 + J
    Next Cls
Next J
End Sub
 
Upvote 0
1 cách cù lần nè
:
PHP:
Sub copyTheoCot()
Dim Cls As Range, Rng As Range
Dim J As Integer

For J = 1 To 3
    Set Rng = Cells(1, J).Resize(30)
    For Each Cls In Rng
        i = Range("m10000").End(xlUp).Row + 1
        Range("M" & i) = Cls.Value
        Range("M" & i).Interior.ColorIndex = 35 + J
    Next Cls
Next J
End Sub
Em tự học lên chỉ hiểu được các cách cù lần, quan trọng là đạt được mục đích bác ah. Cám ơn bác nhé :)
 
Upvote 0
Em chào các thầy cô ạ. Quy luật như thế này em sẽ đưa vào For.....next như nào ạ. Ngồi nghĩ mà chưa thông được. Nhờ các thầy cô chỉ giúp ạ. Em xin cám ơn
Mã:
With Sheets("KQ")
    sCot = 12
    .[E5].Value = ws.Cells(56, sCot + 1).Value
    .[E6].Value = ws.Cells(56, sCot + 2).Value
    .[E7].Value = ws.Cells(56, sCot).Value
    .[F5].Value = ws.Cells(22, sCot + 1).Value
    .[F6].Value = ws.Cells(22, sCot + 2).Value
    .[F7].Value = ws.Cells(22, sCot).Value
    .[G5].Value = ws.Cells(38, sCot + 1).Value
    .[G6].Value = ws.Cells(38, sCot + 2).Value
    .[G7].Value = ws.Cells(38, sCot).Value
    .[H5].Value = ws.Cells(58, sCot + 1).Value
    .[H6].Value = ws.Cells(58, sCot + 2).Value
    .[H7].Value = ws.Cells(58, sCot).Value
    .[I5].Value = ws.Cells(59, sCot + 1).Value
    .[I6].Value = ws.Cells(59, sCot + 2).Value
    .[I7].Value = ws.Cells(59, sCot).Value
    .[J5].Value = ws.Range("F56").Value
    .[J6].Value = ws.Range("G56").Value
    .[J7].Value = ws.Range("E56").Value
    .[K5].Value = ws.Range("F22").Value
    .[K6].Value = ws.Range("G22").Value
    .[K7].Value = ws.Range("E22").Value
    .[L5].Value = ws.Range("F38").Value
    .[L6].Value = ws.Range("G38").Value
    .[L7].Value = ws.Range("E38").Value
    .[M5].Value = ws.Range("F58").Value
    .[M6].Value = ws.Range("G58").Value
    .[M7].Value = ws.Range("E58").Value
    .[N5].Value = ws.Range("F59").Value
    .[N6].Value = ws.Range("G59").Value
    .[N7].Value = ws.Range("E59").Value
    End With
 
Upvote 0
Bạn thử với cái ni trong file của bạn xem sao:
PHP:
Sub GPE()
 Dim wS As Worksheet
 Dim Col As Integer, Rws As Long
 
' Set wS = ThisWorkbook.Worksheets("CSDL")  '
 sCot = 12
With Sheets("KQ")
    For Col = 5 To 9
        Rws = Choose(Col - 4, 56, 22, 38, 58, 59)
        .Cells(5, Col).Value = wS.Cells(Rws, sCot + 1).Value
        .Cells(6, Col).Value = wS.Cells(Rws, sCot + 2).Value
        .Cells(7, Col).Value = wS.Cells(Rws, sCot + 0).Value
    Next Col
Rem    .[E5].Value = wS.Cells(56, sCot + 1).Value '5'
Rem    .[E6].Value = wS.Cells(56, sCot + 2).Value
Rem    .[E7].Value = wS.Cells(56, sCot).Value
Rem    .[F5].Value = wS.Cells(22, sCot + 1).Value  '6'
Rem    .[F6].Value = wS.Cells(22, sCot + 2).Value
Rem    .[F7].Value = wS.Cells(22, sCot).Value
Rem    .[G5].Value = wS.Cells(38, sCot + 1).Value  '7'
Rem    .[G6].Value = wS.Cells(38, sCot + 2).Value
Rem    .[G7].Value = wS.Cells(38, sCot).Value
Rem    .[H5].Value = wS.Cells(58, sCot + 1).Value  '8'
Rem    .[H6].Value = wS.Cells(58, sCot + 2).Value
Rem    .[H7].Value = wS.Cells(58, sCot).Value
Rem    .[I5].Value = wS.Cells(59, sCot + 1).Value  '9'
Rem    .[I6].Value = wS.Cells(59, sCot + 2).Value
Rem    .[I7].Value = wS.Cells(59, sCot).Value
    For Col = 10 To 14
        Rws = Choose(Col - 9, 56, 22, 38, 58, 59)
        .Cells(5, Col).Value = wS.Cells(Rws, "F").Value
        .Cells(6, Col).Value = wS.Cells(Rws, "G").Value
        .Cells(7, Col).Value = wS.Cells(Rws, "E").Value
    Next Col
Rem    .[J5].Value = wS.Range("F56").Value '10 '
Rem    .[J6].Value = wS.Range("G56").Value
Rem    .[J7].Value = wS.Range("E56").Value
Rem    .[K5].Value = wS.Range("F22").Value '11'
Rem    .[K6].Value = wS.Range("G22").Value
Rem    .[K7].Value = wS.Range("E22").Value
Rem    .[L5].Value = wS.Range("F38").Value '12 '
Rem    .[L6].Value = wS.Range("G38").Value
Rem    .[L7].Value = wS.Range("E38").Value
Rem    .[M5].Value = wS.Range("F58").Value '13 '
Rem    .[M6].Value = wS.Range("G58").Value
Rem    .[M7].Value = wS.Range("E58").Value
Rem    .[N5].Value = wS.Range("F59").Value '14 '
Rem    .[N6].Value = wS.Range("G59").Value
Rem    .[N7].Value = wS.Range("E59").Value
End With
End Sub
$$$$@
 
Upvote 0
Một cách khác.Sửa tên sheets thành tên sheets trong file của bạn
Mã:
Sub Quy_Luat()
Dim sCot&, i&, j&, K&, R&
sCot = 12
For i = 1 To 5
        For j = 1 To 3
                K = K + 1
                K = IIf(K = 3, 0, K)
            R = IIf(i = 1, 56, IIf(i = 2, 22, IIf(i = 3, 38, IIf(i = 4, 58, IIf(i = 5, 59, "")))))
            Sheet1.Cells(j + 4, i + 4).Value = Sheet1.Cells(R, sCot + K).Value
            Sheet1.Cells(j + 4, i + 9).Value = Sheet1.Cells(R, sCot + K).Value
        Next
        K = 0
Next
End Sub
 

File đính kèm

  • GPE_Quy Luật.xlsm
    16.9 KB · Đọc: 4
Upvote 0
@SA_DQ, @Cu Tồ con cám ơn 2 người nhiều ạ. Để mai con test thử ạ
Bài trên tôi nhầm cột bạn xem lại file
Mã:
Option Explicit
Sub Quy_Luat()
Dim i&, j&, R&, C&
For i = 5 To 9
        For j = 5 To 7
                C = j + 1
                C = IIf(C = 8, 5, C)
            R = IIf(i = 5, 56, IIf(i = 6, 22, IIf(i = 7, 38, IIf(i = 8, 58, IIf(i = 9, 59, "")))))
            Sheet1.Cells(j, i).Value = Sheet1.Cells(R, C + 7).Value
            Sheet1.Cells(j, i + 5).Value = Sheet1.Cells(R, C).Value
        Next
Next
End Sub
 

File đính kèm

  • GPE_Quy Luật.xlsm
    16.1 KB · Đọc: 5
Lần chỉnh sửa cuối:
Upvote 0
Em chào các thầy cô ạ. Quy luật như thế này em sẽ đưa vào For.....next như nào ạ. Ngồi nghĩ mà chưa thông được. Nhờ các thầy cô chỉ giúp ạ. Em xin cám ơn
Mã:
With Sheets("KQ")
    sCot = 12
    .[E5].Value = ws.Cells(56, sCot + 1).Value
    .[E6].Value = ws.Cells(56, sCot + 2).Value
    .[E7].Value = ws.Cells(56, sCot).Value
    .[F5].Value = ws.Cells(22, sCot + 1).Value
    .[F6].Value = ws.Cells(22, sCot + 2).Value
    .[F7].Value = ws.Cells(22, sCot).Value
    .[G5].Value = ws.Cells(38, sCot + 1).Value
    .[G6].Value = ws.Cells(38, sCot + 2).Value
    .[G7].Value = ws.Cells(38, sCot).Value
    .[H5].Value = ws.Cells(58, sCot + 1).Value
    .[H6].Value = ws.Cells(58, sCot + 2).Value
    .[H7].Value = ws.Cells(58, sCot).Value
    .[I5].Value = ws.Cells(59, sCot + 1).Value
    .[I6].Value = ws.Cells(59, sCot + 2).Value
    .[I7].Value = ws.Cells(59, sCot).Value
    .[J5].Value = ws.Range("F56").Value
    .[J6].Value = ws.Range("G56").Value
    .[J7].Value = ws.Range("E56").Value
    .[K5].Value = ws.Range("F22").Value
    .[K6].Value = ws.Range("G22").Value
    .[K7].Value = ws.Range("E22").Value
    .[L5].Value = ws.Range("F38").Value
    .[L6].Value = ws.Range("G38").Value
    .[L7].Value = ws.Range("E38").Value
    .[M5].Value = ws.Range("F58").Value
    .[M6].Value = ws.Range("G58").Value
    .[M7].Value = ws.Range("E58").Value
    .[N5].Value = ws.Range("F59").Value
    .[N6].Value = ws.Range("G59").Value
    .[N7].Value = ws.Range("E59").Value
    End With
Thử code
Mã:
Sub ABC()
  Dim ws As Worksheet, C_R
 
  Set ws = Sheet1 'Tam tinh
  C_R = Array(56, 22, 38, 58, 59) ' chuyen tu cot sang dong
 
  With Sheets("KQ")
    For j = 5 To 14 'Cot ket qua tu cot "E den N"
      iR = C_R(j Mod 5) 'Dong lay du lieu
      For i = 5 To 7
        If j < 10 Then
          jC = 12 + ((i - 1) Mod 3) 'Cot lay du lieu
        Else
          jC = 6 + ((i + 1) Mod 3)
        End If
        .Cells(i, j).Value = ws.Cells(iR, jC).Value
      Next i
    Next j
  End With
End Sub
 
Upvote 0
Chào mọi người em có viết 1 hàm như bên dưới, nhưng khi dữ liệu gốc là dạng cột thì lại không giống như ý muốn (Ý muốn là cách xếp giống như đã làm được ở Hình 1)
làm sao để nhận biết được dữ liệu gốc đang ở hàng hay cột để viết cho ổn ạ? Em định viết thêm 1 hàm khác nhưng chắc là các anh/chị có thể để chung 1 hàm được nên xin chỉ giáo ạ.
1604626139406.png

1604626274046.png
Mã:
Function TRANSPOSES(rng As Range, col As Integer)
Application.Volatile
dong = Application.WorksheetFunction.RoundUp(rng.Columns.Count / col, 0)
ReDim arr2(1 To dong, 1 To col)
arr = rng.Resize(1, dong * col)
For i = 1 To dong
     For j = 1 To col
     arr2(i, j) = arr(1, (i - 1) * col + j)
     Next j
Next i
TRANSPOSES = arr2
End Function
 
Upvote 0
Chào mọi người em có viết 1 hàm như bên dưới, nhưng khi dữ liệu gốc là dạng cột thì lại không giống như ý muốn (Ý muốn là cách xếp giống như đã làm được ở Hình 1)
làm sao để nhận biết được dữ liệu gốc đang ở hàng hay cột để viết cho ổn ạ? Em định viết thêm 1 hàm khác nhưng chắc là các anh/chị có thể để chung 1 hàm được nên xin chỉ giáo ạ.
Vòng lặp phải chạy theo nguồn chứ sao lại chạy theo đích
PHP:
Function TRANSPOSES(rng As Range, col As Integer)
Application.Volatile
dong = Application.WorksheetFunction.RoundUp(rng.Count / col, 0)
ReDim arr2(1 To dong, 1 To col)
arr = rng.Value
m = 1
For i = 1 To UBound(arr, 1)
     For j = 1 To UBound(arr, 2)
     n = n + 1
     arr2(m, n) = arr(i, j)
     If n = col Then n = 0: m = m + 1
     Next j
   
Next i
TRANSPOSES = arr2
End Function
 
Lần chỉnh sửa cuối:
Upvote 0
Web KT
Back
Top Bottom