pc23th 電腦學習

msgbox "測試" & vbcr & "換行成功"

[方案1] 比 [方案2] 效率好很多 With ShtXX Mod_i = i Mod 10 '取得尾數 Sort_R1 = Stay + (All_Ball) * Mod_i Sotr_C1 = (All_Ball - 1 + Stay) + (All_Ball) * Mod_i 'lLastCol '[方案1] lLastCol = 1 + 3 * (i \ 10) '初始值 + 間隔值 * 次數 '[方案2] 'lLastCol = .Cells(Sort_R1, Cells.Columns.Count).End(xlToLeft).Column '橫式輸出 ShtXX.Range(.Cells(Sort_R1, lLastCol + 2), .Cells(Sotr_C1, lLastCol + 3)) = arrBall_Rng '由大→小排序 Set XX_Rng = .Cells(Sort_R1, lLastCol + 2).CurrentRegion XX_Rng.Cells(1, 2).Sort _ key1:=XX_Rng.Columns(2), Order1:=xlDescending, Header:=xlGuess End With

檢查 IE裏的 [工具]→[網際網路選項]→[連線]→ 試選        網路連線不存在時撥號 或選        永遠不撥號連線

Function Fn2_新增頁表()     Dim Sht9Star As Object     Next_Con=1     On Error GoTo create         Set Sht9Star = Sheets("九星下" & Next_Con)         Exit Function create:         Sheets.Add(after:=Sheets(Sheets.Count)).Name = "九星下" & Next_Con End Function

Function temp234() Dim arr(1 To 10) As Integer     For i = 1 To 10         arr(i) = i     Next i     '橫向寫入     Sheets("test").Range("a1:j1") = arr     '直向寫入     Sheets("test").Range("a1:a10") = Application.WorksheetFunction.Transpose(arr) End Function

Function Color_test()     For j = 1 To 10         Cells(1, j) = j         With Cells(1, j).Interior             .PatternColorIndex = xlAutomatic    '設定顏色             .ThemeColor = j             .TintAndShade = 0.399975585192419   '設定深淺         End With     Next j End Function

a= ABS(28-38) debug.print a

for j = lLastRow to 1 Step -1  'Step 設定每次要減少或增加的數值     debug.print j next j

如果先把資料整理好，有順序的話，那麼使用countA，會快很多     '統計機率         Dim i As Integer, j As Integer         lLastRow = ShtXy.Range("A" & Cells.Rows.Count).End(xlUp).Row         Set myTbl = ShtXy.Range("A" & lLastRow).CurrentRegion         For j = 1 To All_Ball             If j < 10 Then                 chkBall = "0" & j             Else                 chkBall = j             End If             Per_x = Application.CountA(myTbl.Columns(j + 2))    '改這樣變更快，資源佔用少            'Per_x = Application.CountIf(myTbl, chkBall)         '舊程式             With ShtTmp                 i = 1                 .Cells(j + 2, i + 1) = Per_x                '次數                 .Cells(j + 2, i + 2) = chkBall              '球號                 .Cells(j + 2, i + 3) = arrShowBallCon(j)    '落號距離             End With         Next

LARGE找前三大 a1=LARGE($A$1:$A$6,1) a2=LARGE($A$1:$A$6,2) a3=LARGE($A$1:$A$6,3) SMALL找前三小 a1=SMALL($A$1:$A$6,1) a2=SMALL($A$1:$A$6,2) a3=SMALL($A$1:$A$6,3)

http://tw.search.yahoo.com/search/kp;_ylt=A8tUwYjRniBOk2YAEjKS1gt.?p=excel+vba+max&fr2=sb-top C1=MIN(50,MAX(40,INT(($B1-1)/10000)+33+($A1="晚")*2))/100

Function Fn2_依顏色排序()     '變數設定         Set Sht348 = Sheets(LotoShowCon & "取位")     '自定顏色排序         With Sht348.Sort.SortFields             .Clear             .Add(Range("F20:F27"), _                 xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = #eeece1             .Add(Range("F20:F27"), _                 xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = #4f81bd             .Add(Range("F20:F27"), _                 xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = #c0504d             .Add(Range("F20:F27"), _                 xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = #9bbb59             .Add(Range("F20:F27"), _                 xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = #8064a2             .Add(Range("F20:F27"), _                 xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = #4bacc

Function find_max()     '初始值         LotoShowCon = 100048     '變數設定         Set Sht348 = Sheets(LotoShowCon & "取位")     '找最大         'Dim arr_tmp(0 To 1) As Variant         ar = Application.Max(Sht348.Range("E4:BA4")) '.Value         Debug.Print ar End Function

技巧 070     cells.interior.colorindex = xlNone

技巧028   Sub CheckDeleteSheet()      Dim bDeleted As     Boolean      bDeleted = Worksheets(1).Delete      If bDeleted Then          MsgBox "成功删除工作表。", vbInformation      Else          MsgBox "使用者取消删除。", vbInformation      End If   End Sub 執行下面程式碼需保證存在Sheet1工作表物件   Sub DeleteSheetWithoutAlert()      Application.DisplayAlerts = False      Sheet1.Delete      Application.DisplayAlerts = True   End Sub

原來設定框線要做四次，上下左右 而且範圍只能用.Range(.Cells(2, 8), .Cells(2, 17))不能使用.cells(.Cells(2, 8), .Cells(2, 17)) 雖然，使用cells會比較快一些，但是在無法使用之下，也是沒辦法的            Set LinStyle = .Range(.Cells(2, 8), .Cells(2, 17))                 With LinStyle                     .Borders(xlEdgeLeft).Weight = xlMedium                     .Borders(xlEdgeTop).Weight = xlMedium                     .Borders(xlEdgeBottom).Weight = xlMedium                     .Borders(xlEdgeRight).Weight = xlMedium               End With 技巧 069  Sub AddBorders()      Dim rng As Range      Set rng = Range("B2:F10")      With rng.Borders    '設定儲存格範圍框線          .LineStyle = xlContinuous          .Weight = xlThin          .ColorIndex = 5      End With      rng.BorderAround xlContinuous, xlMedium, 5    '應用外框線      Set rng = Nothing  End Sub  Sub AddBorders_1()      Dim rng As Range      Set rng = Range("B2:F10")      With rng.Borders(xlInsideHorizontal)       '設定儲存格範圍水平方向框線          .LineStyle = xlDot          .Weigh

Function 將取樣值上色()     LotoShowCon=100048     '初始值     Dim ShowBall As Integer         All_Ball = 49       '總球數         ShowBall = 7     '變數設定     Dim ShtLotoOrg As Object, Sht348 As Object         Set ShtLotoOrg = Sheets("大樂透落球")         Set Sht348 = Sheets(LotoShowCon & "取位")     '主程式     Dim Sht348_Ball As Object, Org_Ball As String     Dim arrBallchk     ReDim arrBallchk(1 To ShowBall) As Variant         With ShtLotoOrg             lLastRow = .Range("B" & Cells.Rows.Count).End(xlUp).Row             Set Fld = .Range(.Cells(3, 2), .Cells(lLastRow, 2))             Set Loto_Rng = Fld.Find(What:=LotoShowCon, LookAt:=xlWhole)             For i = 1 To ShowBall                 arrBallchk(i) = Loto_Rng.Offset(-1, i).Value             Next         End With                  Set sht348_Rng = Sht348.Range("C" & Cells.Rows.Count).End(xlUp).CurrentRegion         For i = 1 To UBound(arrBallchk, 1)             Set chkBall = sht348_R

1、鏡頭是平的，不要凸出來、也不要有蓋子的，這樣才方便攜帶 2、重量一定要輕 3、手提的帶子，不要找綁雙側的，要找綁單側，拍照時會因為帶子的問題，很卡 4、要有自拍功能

                Set tmpSht = Sheets.Add(After:=Sheets(Sheets.Count))         tmpSht.Name = "新工作表"