妹咕好多了

妹咕好一點了
謝謝大家

EXCEL VBA 對話工作表傳值

Sub 顯示()
DialogSheets("Dialog1").Show
Sheets(2).Select
Select Case
Range("B4").Value
Case 1
Range("B4").Value = 95
Range("C4").Value = 20
Case 2
Range("B4").Value = 98
Range("C4").Value = 22
Case 3
Range("B4").Value = 92
Range("C4").Value = 21
Case 4
Range("B4").Value = 柴油
Range("C4").Value = 24
Case Else
Range("B4").Value = 機油
Range("C4").Value = 23
End Select
End Sub

EXCEL VBA 對話工作表顯示

Sub 顯示()
Sheets("Dialog1").Select DialogSheets("Dialog1").Show
End Sub

EXCEL VBA 年加1911

Sub 年計()
Range("D2").Select
While (ActiveCell.Value <> Empty)
ActiveCell.Value = ActiveCell.Value + 1911
ActiveCell.Offset(1, 0).Select
Wend
End Sub

EXCEL VBA 向下填滿自動

Sub 向下填滿()
Z = 0 ' 次數
Range("a1").Select
ActiveCell.SpecialCells(xlLastCell).Select
E = ActiveCell.Row
Range("a1").Select
For i = 1 To E ' 填滿次數
x = ActiveCell.Value
Selection.End(xlDown).Select
y = ActiveCell.Value
If x <> y Then Z = Z + 1
End If
Next
Range("a1").Select
For i = 1 To Z - 1
x = ActiveCell.Address
Selection.End(xlDown).Select
ActiveCell.Offset(-1, 0).Select
y = ActiveCell.Address
W = x & ":" & y
Range(W).Select
Selection.FillDown
Selection.End(xlDown).Select
Next
End Sub

EXCEL VBA 合併

Sub 合併()
Range("D2").Select
While (ActiveCell.Value <> Empty)
ActiveCell.Value = ActiveCell.Value & "/" & ActiveCell.Offset(0, 1).Value & "/" & ActiveCell.Offset(0, 2).Value
ActiveCell.Offset(0, 1).ClearContents
ActiveCell.Offset(0, 2).ClearContents
ActiveCell.Offset(1, 0).Select
Wend
End Sub

EXCEL VBA 年加11

Sub 年計()
Range("E1").Select
ActiveCell.FormulaR1C1 = "11"
Selection.Copy
Range("D2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlAdd, SkipBlanks _
:=False, Transpose:=False
Range("E1").Select
Application.CutCopyMode = False
Selection.ClearContents
End Sub

EXCEL VBA 向下填滿

Sub 向下填滿()
Z = 0 ' 次數
Range("a65536").Select
Selection.End(xlUp).Select ' 計量
E = ActiveCell.RowRange("a1").Select
For i = 1 To E ' 填滿次數
x = ActiveCell.Value
Selection.End(xlDown).Select
y = ActiveCell.Value
If x <> y Then
Z = Z + 1
End If
Next
Range("a1").Select
For i = 1 To Z - 1
x = ActiveCell.Address
Selection.End(xlDown).Select
ActiveCell.Offset(-1, 0).Select
y = ActiveCell.Address
W = x & ":" & y
Range(W).Select
Selection.FillDown
Selection.End(xlDown).Select
Next
End Sub

EXCEL VBA 匯入

Sub 匯入CSV()
x = InputBox("請輸入檔案數量")
Range("a1").Select
For i = 1 To x
If i = 1 Then
z = 1
Else
z = 2
End If
y = ActiveCell.Address
With ActiveSheet.QueryTables.Add(Connection:="TEXT;C:\twm\" & i & ".csv", _ Destination:=Range(y))
.Name = "1"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 950
.TextFileStartRow = z
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = True
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = True
.TextFileColumnDataTypes = Array(1, 1, 1, 5)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
Application.CommandBars("External Data").Visible = False
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Select
Next
End Sub

天啊硬碟掛了

今天我的硬碟掛了
好可怕喔
我快哭了
結果妹咕說
阿爸 你怎麼這麼笨
買新的就好了
學長如看到本篇發表 , 請將本人資料燒錄多張光碟再還本人

EXCEL VBA資料分割OK

Sub 資料轉移()
Range("a2").Select
x1 = ActiveCell.Row
Selection.End(xlDown).Select
y = ActiveCell.RowRange("a2").Select
k = 2
For i = 2 To y
If ActiveCell.Value <> ActiveCell.Offset(1, 0).Value Then
x2 = ActiveCell.Row
x = x1 & ":" & x2
Range(x).Select
Selection.Copy
Sheets(k).Select
Range("A2").Select
ActiveSheet.Paste
k = k + 1
Sheets(1).Select
x1 = x2 + 1
Cells(x1, 1).Select
End If
ActiveCell.Offset(1, 0).SelectNext
End Sub

EXCEL - VBA 資料轉移

Sub 資料轉移()
Range("a2").Select
x1 = ActiveCell.Row
Selection.End(xlDown).Select
Y = ActiveCell.Row
Range("a2").Select
For i = 1 To Y
If ActiveCell.Value <> ActiveCell.Offset(1, 0).Value Then
x2 = ActiveCell.Row
x = x1 & ":" & x2
Range(x).Select
Selection.Copy
Sheets(2).Select
ActiveSheet.Paste
End If
ActiveCell.Offset(1, 0).Select
Next
End Sub

EXCEL VBA 分類命名

Sub 分類()
Range("a2").Select
Selection.End(xlDown).Select
Y = ActiveCell.Row
Range("a2").Select
x = 0
For i = 1 To Y
If ActiveCell.Value <> ActiveCell.Offset(1, 0).Value Then
Sheets.Add
x = x + 1
x1 = Sheets.Count
Sheets(x1).Select
Sheets(x).Name = ActiveCell.Value
End If
ActiveCell.Offset(1, 0).Select
Next
x1 = Sheets.Count
Sheets(x1).Select
Sheets(x1).Move Before:=Sheets(1)
End Sub

EXCEL -VBA 分類

Sub 分類()
Range("a2").Select
Selection.End(xlDown).Select
Y = ActiveCell.Row
Range("a2").Select
x = 0
For i = 1 To Y
If ActiveCell.Value <> ActiveCell.Offset(1, 0).Value Then
x = x + 1
Else
x = x
End If
ActiveCell.Offset(1, 0).Select
Next
MsgBox x
End Sub

EXCEL VA 複製

Ｓｕｂ　複製（）

　　　　Ｄｉｍ　ｍｙｓｈｔ１，　ｍｙｓｈｔ２　Ａｓ　Ｗｏｒｋｓｈｅｅｔ
　　　　Ｄｉｍ　ｍｙｒｎｇ１，　ｍｙｒｎｇ２　Ａｓ　Ｒａｎｇｅ
　　　　Ｄｉｍ　ｘ，　ｙ
　　　　
　　　　Ｓｅｔ　ｍｙｓｈｔ１　＝　Ｗｏｒｋｓｈｅｅｔｓ（１）
　　　　　Ｓｅｔ　ｍｙｓｈｔ２　＝　Ｗｏｒｋｓｈｅｅｔｓ（２）
　　　　ｍｙｓｈｔ１．Ｒａｎｇｅ（＂Ａ１＂）．Ｓｅｌｅｃｔ
　　　　ＡｃｔｉｖｅＣｅｌｌ．ＳｐｅｃｉａｌＣｅｌｌｓ（ｘｌＬａｓｔＣｅｌｌ）．Ｓｅｌｅｃｔ
　　　　ｘ　＝　ＡｃｔｉｖｅＣｅｌｌ．Ａｄｄｒｅｓｓ
　　　　Ｓｅｌｅｃｔｉｏｎ．Ｅｎｄ（ｘｌＵｐ）．Ｓｅｌｅｃｔ
　　　　Ｓｅｌｅｃｔｉｏｎ．Ｅｎｄ（ｘｌＴｏＬｅｆｔ）．Ｓｅｌｅｃｔ
　　　　ｙ　＝　ＡｃｔｉｖｅＣｅｌｌ．Ａｄｄｒｅｓｓ
　　　　
　　　　ｘ　＝　ｘ　＆　＂：＂　＆　ｙ
　　　　Ｓｅｔ　ｍｙｒｎｇ１　＝　Ｒａｎｇｅ（ｘ）
　　　　Ｓｅｔ　ｍｙｒｎｇ２　＝　ｍｙｓｈｔ２．Ｒａｎｇｅ（ｙ）
　　　　ｍｙｒｎｇ１．Ｃｏｐｙ　Ｄｅｓｔｉｎａｔｉｏｎ：＝ｍｙｒｎｇ２
　　　　Ｓｅｔ　ｍｙｒｎｇ１　＝　Ｎｏｔｈｉｎｇ
　　　　　Ｓｅｔ　ｍｙｒｎｇ２　＝　Ｎｏｔｈｉｎｇ
Ｅｎｄ　Ｓｕｂ

清除小數 - EXCEL VBA

Sub 清除小數()
Range("A1").Select
ActiveCell.SpecialCells(xlLastCell).Select
x2 = ActiveCell.Row
y2 = ActiveCell.Column
Selection.End(xlUp).Select
Selection.End(xlToLeft).Select
x1 = ActiveCell.Row
y1 = ActiveCell.Column
For i = 0 To x2 - x1
For j = 0 To y2 - y1
If Int(ActiveCell.Offset(i, j).Value) <> ActiveCell.Offset(i, j).Value Then
ActiveCell.Offset(i, j).Value = Int(ActiveCell.Offset(i, j).Value)
End If
Next
Next
End Sub

清除零值 - EXCELVBA

方法一
Sub 清除零值()
Range("A1").Select
ActiveCell.SpecialCells(xlLastCell).Select
x2 = ActiveCell.Row
y2 = ActiveCell.Column
Selection.End(xlUp).Select
Selection.End(xlToLeft).Select
x1 = ActiveCell.Row
y1 = ActiveCell.Column
For i = x1 To x2
For j = y1 To y2
If Cells(i, j) = 0 Then
Cells(i, j) = Empty
End If
Next
Next
End Sub


方法二


Sub 清除零值()
Range("B2").Select
For i = 1 To 15
For j = 1 To 15
If ActiveCell.Offset(i - 1, j - 1).Value = 0 Then
ActiveCell.Offset(i - 1, j - 1).Value = Empty
End If
Next

Next
End Sub

HTML的跑馬燈語法

以下語法請參考喔
＜ｍａｒｑｕｅｅ　ｏｎｍｏｕｓｅｏｖｅｒ＝ｔｈｉｓ．ｓｔｏｐ（）　ｏｎｍｏｕｓｅｏｕｔ＝ｔｈｉｓ．ｓｔａｒｔ（）　ｓｃｒｏｌｌＡｍｏｕｎｔ＝20　＞＜ＦＯＮＴ　．．．　ｃｏｌｏｒ＝＃９９００００　ｓｉｚｅ＝２　＞歡迎來到妹咕網站＜／ｆｏｎｔ＞　＜／ｍａｒｑｕｅｅ＞

給網頁設計的同學們

請同學快去申請 ,
週三上課可以使用喔
到BLOG右側的PHP空間
不會申請沒關係 , 老師上課會教喔
http://www.free-webhosts.com/webhosting-01.php
http://www.free-webhosts.com/webhosting-02.php