Nhờ giúp: Chạy 1 lần 2 Sub, Định dạng màu chữ bằng VBA (1 người xem)

[khoavu87]

ngoài ra e còn có ý nghĩ này nhưng chưa làm ra,Mọi xem rùi giúp e nhé.
-1/ trong bài làm của e có hai "sub.....end sub"mỗi lần chạy e
phỉ chạy lần lượt xong "sub"1 đợi chạy xong cháu lại phải chọn sub2
rùi F5 để chạy,giờ e muốn khi ấn f5 thì "sub tinhthuyvan()"chạy
xong thì sub "tinhQp"tự động chạy luôn ko cần thao tác f5 nữa.
-2/e muốn các vùng có số liệu mình nhập mặc định trong ex thì có một
màu chữ khác,các vùng mà mình tính đc do dùng code trong VBA là màu
chữ khác.
Anh có thời gian thì giúp e nhé.e cảm ơn,thật sự e chưa bít
nhiueef về VBA trong ex lắm ,cần sự giuos đỡ của Anh.thank

 

[Pozsi]

-1/Thì cuối cùng của Sub tinhthuyvan() bạn nhập thêm dòng "Call tinhQp" là được chứ gì.

Sub tinhthuyvan()
.....
Call tinhQp
End Sub

-2/Câu 2 thật sự mình ko biết phải gì nữa? Bạn nói "chưa bít nhiều VBA" mà trong file có 1 đóng code luôn. Mình đọc vào còn rối mắt nữa chứ là.... hi hi hi
Chúc vui.

 

[khoavu87]

cảm ơn anh nhiều,anh có thể xem qua code của em và rút gọn code cảu em đc ko.em nghĩ vẫn còn dài dòng quá,thank

mình thử cái của pózii rùi nhưng ko chạy đc,xem lại cho mình đc ko?

 

[khoavu87]

Sub tinhthuyvan()
.....
tinhQp
End Sub
nhu vay moi chay dc,hihi

 

[SA_DQ]

Bạn hãy thử với số liệu của bạn xem macro sửa đúng không nha!

Anh có thể xem qua code của em và rút gọn code cảu em đc ko.em nghĩ vẫn còn dài dòng quá,thank
mình thử cái của pózii rùi nhưng ko chạy đc,xem lại cho mình đc ko?

Public Sub TinhQp()
  Dim Q1 As Double, Q2 As Double, Q3 As Double, Q25 As Double, Q70 As Double
  Dim Q90 As Double, Q99 As Double, Cv As Double, Qtb As Double
  ReDim DelTa_(1 To 7) As Double:                  Dim jJ As Byte
 
Cv = ThisWorkbook.Worksheets("Sheet1").Range("J16").Value
With ThisWorkbook.Worksheets("Sheet2")
   For jJ = 1 To 7
      DelTa_(jJ) = Cells(16, jJ + 4).Value ' 5 ~ "E"'
   Next jJ
   .Range("D16").Value = "   Kp% ="
   .Range("D17").Value = "   Qp% ="
End With
Qtb = ThisWorkbook.Worksheets("Sheet1").Range("G14").Value
For jJ = 1 To 7
   Choose(jJ, Q1, Q2, Q3, Q25, Q70, Q90, Q99) = Qtb * (DelTa_(jJ) * Cv + 1)
Next jJ
With ThisWorkbook.Worksheets("Sheet2")
   For jJ = 1 To 7
      Cells(17, 4 + jJ).Value = Choose(jJ, Q1, Q2, Q3, Q25, Q70, Q90, Q99)
   Next jJ
  .[E15:K15].Copy:               .[E20:K20].PasteSpecial _
           'Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False'
  .Range("D20").Value = "     P% ="
  .[D17:K17].Copy:               .[D21:K21].PasteSpecial _
           'Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End With
 
 Dim Chrt As ChartObject
 Set Chrt = ThisWorkbook.Worksheets("Sheet4").ChartObjects.Add(100, 30, 400, 250)
 Chrt.Name = "Bieu do"
 Chrt.Chart.ChartWizard ThisWorkbook.Worksheets("Sheet2").Range("E20:K21"), _
      xlLine, , xlRows, 1, 1, True, "BIEU DO TAN SUAT THEO LY THUYET", "Qp%", "P%"
End Sub

 

[huyen342000]

mình đang tập tành vba, tổng hợp các sheet giống nhau vào 1 sheet, nhấn F5 cứ hiện cái bảng thông báo

---------------------------
Microsoft Visual Basic
---------------------------
The macros in this project are disabled. Please refer to the online help or documentation of the host application to determine how to enable macros.
---------------------------
OK Help
---------------------------


Bạn xem giúp mình nhé


Sub Combine()
Dim J As Integer
On Error Resume Next
Sheets(1).Select
Worksheets.Add
Sheets(1).Name = "Combined"
Sheets(2).Activate
Range("A1").EntireRow.Select
Selection.Copy Destination:=Sheets(1).Range("A1")
For J = 2 To Sheets.Count
Sheets(J).Activate
Range("A1").Select
Selection.CurrentRegion.Select
Selection.Offset(1, 0).Resize(Selection.Rows.Count - 1).Select
Selection.Copy Destination:=Sheets(1).Range("A65536").End(xlUp)(2)
Next
End Sub