Private Sub CommandButton1_Click()
'Range("A2").Value = txtHo.Text
'Range("B2").Value = txtTen.Text
'Range("C2").Value = txtDt.Value
Range("A2").Select
ActiveCell.End(xlDown).Select
lastrow = ActiveCell.Row
Cells(lastrow + 1, 1).Value = txtHo.Text
Cells(lastrow + 1, 2).Value = txtTen.Text
Cells(lastrow + 1, 3).Value = txtDt.Text
Range("A2").Select
txtHo.Text = ""
txtTen.Text = ""
txtDt.Text = ""
End Sub
Range("A2").Select
ActiveCell.End(xlDown).SelectRange("A65536").End(xlUp).Offset(1,0)Select
cảm ơn bạn, mình đã làm thử và nó đã trả về địa chỉ của ô!
Khi thực thi macro này thì ta sẽ có hàm NSTT, trong đó phải chọn 3 giá trị: mang1, mang2 và giá trị cần nội suy
E cảm ơn ạ. Nhưng a có thể sửa giúp e sự kiện Caculation được ko ạ. E đang học về VBA ạ
Thua bài đầu tiên bạn hỏi Selection.Offset(1, 0).Select và tôi đã giải thích thì bạn nói là biết rồi nhưng làm sao ghi Macro
Hi không hiểu sao đính kèm bị lỗi
Nút in của bạn, thay bằng đoạn code này thử xem
Private Sub CommandButton2_Click()
For i = 2 To Sheet12.Range("C65000").End(xlUp).Row
Sheets(Sheet12.Range("C" & i).Value).PrintOut
Next i
End SubHi thực sự thì mình chỉ mới tập tọe sử dụng VBA thôi, bác "giaiphap" có thể sửa giùm mình đoạn code đó được không? Hoặc không bác có thể nói rõ hơn là thay đoạn code nào bằng đoạn code của bác không? Có phải ý bác là thay đoạn
Không được rồi bác ơi, Em chạy code của bác sửa lại cho em rồi, nó in hết tất tần tật các sheet ra bác ạ .
Em chạy code của bác sửa lại cho em rồi, nó in hết tất tần tật các sheet ra bác ạ
Em đang mò mẫm học phần này nên ứng dụng thử xem sao. E xin cảm ơn ạ
Bạn thử dùng code sauEm chạy code của bác sửa lại cho em rồi, nó in hết tất tần tật các sheet ra bác ạ
Private Sub CommandButton2_Click()
Dim i&
For i = 1 To Sheets.Count
If Cells(i, 4) = 1 Then Sheets(Cells(i, 3).Value).PrintOut
Next
End SubCái này thì cứ vào validation mà tạo, cần gì vba đâu bạn.
Chuẩn rồi bác ạ. đúng ý em rồi, hê hê. Cảm ơn bác nhiều lắm lắm!
Vâng ạ, em làm validation rồi ạ. hôm trước em hỏi nhưng xong em k tìm được topic ở đâu để vào xem
. e đang mày mò học nên nhiều khi hơi quan trọng hoá vấn đề lên
Giả sử A1 là 13000. Tại B1:
=TEXT(A1,"#,##0")Dạ em xin lỗi nhưng em muốn hỏi về VBA cơ ạ, code để e viết trong VBA để tạo dòng diễn giải ạ. E cảm ơn!
e sửa đc vào code rồi ạ. e cảm ơn
Bạn thêm một điều kiện nữa. Như vầy
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 1 And Not IsEmpty(Target(1)) Then
Target.Offset(0, 1).Value = Target
End If
End Sub1. Bạn không nên nhờ đích danh một người như thế.
Bạn thử với:
Sub ABC()
Dim Nguon As Workbook, Dich As Workbook
Dim wsN As Worksheet, wsD As Worksheet
Set Nguon = ThisWorkbook: Set wsN = Nguon.Sheets(1)
Set Dich = Workbooks.Add
With Dich
Set wsD = Dich.Sheets(1)
wsN.Range("A1:C20").Copy
wsD.Range("A1").PasteSpecial (xlPasteValues)
End With
End SubCode thì tôi làm rồi: đang chọn vùng A1:C20 của Sheet1 copy và paste GIÁ TRỊ và Sheet2 của cùng 1 file workbook (1 file excel).
Di mình k save dc fỏn. Nên mình export ra ngòa với file SM.frm. bạn vào file excel xg mở vba và inport nó là dc. Thanks
Cái này thì ai cũng biết, bạn save lại với phần mở rộng file là *.xlsm là được. Nhưng bạn phải nêu rõ là nhập vào cái gì và tiêu chí tìm kiếm ra sao, kiếm ở sheet nào, cho kết quả bao nhiêu cột...
ví dụ: ở ô Search thì mình nhập mã số Housing ở cột B thì sẽ cho ra kết quả các cột còn lại trên listbox và các ô text box thể hiện các giá trị search tương ứng với các giá trị trên Listbox, mình tham khảo trên Web và làm nhưng k hiêu bị sai chổ gì mà k tìm dc mã số
Sub CreateCalendar2()
'Tao lich nam hien tai
Dim lMonth As Long
Dim strMonth As String
Dim rStart As Range
Dim strAddress As String
Dim rCell As Range
Dim lDays As Long
Dim dDate As Date
Dim i As Long, c As Long
Dim strAddress2 As String
'Add new sheet and format
Worksheets.Add
ActiveWindow.DisplayGridlines = False
With Cells
.ColumnWidth = 6#
.Font.Size = 14
End With
'Create the Month headings
For lMonth = 1 To 4
Select Case lMonth
Case 1
strMonth = "January"
Set rStart = Range("A1")
Case 2
strMonth = "April"
Set rStart = Range("A13")
Case 3
strMonth = "July"
Set rStart = Range("A25")
Case 4
strMonth = "October"
Set rStart = Range("A37")
End Select
'Merge, AutoFill and align months
With rStart
.Value = strMonth
.HorizontalAlignment = xlCenter
.Interior.ColorIndex = 6
.Font.Bold = True
With .Range("A1:G1")
.Merge
.BorderAround LineStyle:=xlContinuous
End With
.Range("A1:G1").AutoFill Destination:=.Range("A1:U1")
End With
Next lMonth
'Pass ranges for months
For lMonth = 1 To 12
strAddress2 = Choose(lMonth, "A2:G12", "H2:N12", "O2:U12", _
"A14:G14", "H14:N14", "O14:U14", _
"A26:G26", "H26:N26", "O26:U26", _
"A38:G38", "H38:N38", "O38:U38")
lDays = 0
'Range(strAddress2).BorderAround LineStyle:=xlContinuous
'Add dates to month range and format
i = 0: c = 0
For Each rCell In Range(strAddress2)
c = Int(i / 7)
lDays = lDays + 1
dDate = DateSerial(Year(Date), lMonth, lDays)
If Month(dDate) = lMonth Then ' It's a valid date
With rCell.Offset(c)
.Value = dDate
.NumberFormat = "dd" '"ddd dd" '"mmmm yyyy"
End With
End If
i = i + 1
Next rCell
Next lMonth
'add con formatting
With Range("A1:U48")
.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, Formula1:="=TODAY()"
.FormatConditions(1).Font.ColorIndex = 2
.FormatConditions(1).Interior.ColorIndex = 1
End With
End Sub
11, rồi ấn DELETE thì dữ liệu cột E sẽ lấy dữ liệu tương ứng bên cột C
Bạn thử như vầy:
Function ThamdinhThietke3(CPXD As Double, Loai_cong_trinh [COLOR=#ff0000]As Double[/COLOR]) 'Tra dinh muc chi phi chung cong trinh DAN DUNG
If Loai_cong_trinh Mod 1 > 0 Or Loai_cong_trinh > 5 Then
MsgBox "Loai cong trinh chua phu hop!" & vbCrLf & vbCrLf _
& "Ban vui long chon Loai_cong_trinh nhu sau:" & vbCrLf _
& "1 = Cong trinh Dan dung" & vbCrLf _
& "2 = Cong trinh Cong nghiep" & vbCrLf _
& "3 = Cong trinh Giao thong" & vbCrLf _
& "4 = Cong trinh Nong nghiep phat trien nong thon" & vbCrLf _
& "5 = Cong trinh Ha tang ky that" & vbCrLf & vbCrLf _
& "Xin cam on!"
Exit Function
End If
Dim Ka, Kb, Kc, Ga, Gb As Double
If Loai_cong_trinh = 1 Then
'.......5 truong hop
Kc = Kb - (Kb - Ka) * (CPXD - Gb) / (Ga - Gb)
Else
Kc = 0.01
End If
ThamdinhThietke3 = Kc / 100
End If
End Function
Bạn thử đoạn sau:
Sub COPY()
Dim lr As Long, er As Long, sh As Worksheet, sh0 As Worksheet, tmp()
Set sh0 = Sheets("DSACH")
sh0.Range("A3:Q65000").ClearContents
For Each sh In ThisWorkbook.Worksheets
If sh.Name <> sh0.Name Then
lr = sh.Cells(Rows.Count, 2).End(xlUp).Row
tmp = sh.Range("B3:Q" & lr).Value
er = sh0.Cells(Rows.Count, 2).End(xlUp).Row + 1
sh0.Range("B" & er).Resize(UBound(tmp, 1), UBound(tmp, 2)).Value = tmp
End If
Next sh
'Dien STT:
sh0.Range("A3:A" & sh0.Cells(Rows.Count, 2).End(xlUp).Row).Value = No(sh0.Range("A3:A" & sh0.Cells(Rows.Count, 2).End(xlUp).Row))
End Sub
Function No(rng As Range) As Variant
If rng.Columns.Count > 1 Then Exit Function
Dim tmp(), i As Long
ReDim tmp(1 To rng.Count, 1 To 1)
For i = 1 To UBound(tmp, 1)
tmp(i, 1) = i
Next i
No = tmp
End FunctionBạn thử lại:
Function ThamdinhThietke3(CPXD As Double, Loai_cong_trinh [COLOR=#0000ff]As Byte[/COLOR]) 'Tra dinh muc chi phi chung cong trinh DAN DUNG
If [COLOR=#0000ff]TypeName(Loai_cong_trinh) <> "Integer"[/COLOR] Or Loai_cong_trinh > 5 Then
MsgBox "Loai cong trinh chua phu hop!" & vbCrLf & vbCrLf _
& "Ban vui long chon Loai_cong_trinh nhu sau:" & vbCrLf _
& "1 = Cong trinh Dan dung" & vbCrLf _
& "2 = Cong trinh Cong nghiep" & vbCrLf _
& "3 = Cong trinh Giao thong" & vbCrLf _
& "4 = Cong trinh Nong nghiep phat trien nong thon" & vbCrLf _
& "5 = Cong trinh Ha tang ky that" & vbCrLf & vbCrLf _
& "Xin cam on!"
Exit Function
End If
Dim Ka, Kb, Kc, Ga, Gb As Double
If Loai_cong_trinh = 1 Then
'.......5 truong hop
' Kc = Kb - (Kb - Ka) * (CPXD - Gb) / (Ga - Gb)
' Else
' Kc = 0.01
' End If
' ThamdinhThietke3 = Kc / 100
End If
End Function
