2008年12月27日星期六

妹咕好多了

妹咕好一點了
謝謝大家

2008年12月25日星期四

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

天啊硬碟掛了

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

2008年12月24日星期三

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

2008年12月23日星期二

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 複製

Sub 複製()

    Dim mysht1, mysht2 As Worksheet
    Dim myrng1, myrng2 As Range
    Dim x, y
    
    Set mysht1 = Worksheets(1)
     Set mysht2 = Worksheets(2)
    mysht1.Range("A1").Select
    ActiveCell.SpecialCells(xlLastCell).Select
    x = ActiveCell.Address
    Selection.End(xlUp).Select
    Selection.End(xlToLeft).Select
    y = ActiveCell.Address
    
    x = x & ":" & y
    Set myrng1 = Range(x)
    Set myrng2 = mysht2.Range(y)
    myrng1.Copy Destination:=myrng2
    Set myrng1 = Nothing
     Set myrng2 = Nothing
End Sub

2008年12月22日星期一

清除小數 - 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

2008年12月21日星期日

HTML的跑馬燈語法

以下語法請參考喔
<marquee onmouseover=this.stop() onmouseout=this.start() scrollAmount=20 ><FONT ... color=#990000 size=2 >歡迎來到妹咕網站</font> </marquee>

給網頁設計的同學們

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

 
妹咕數位學園歡迎網友們來信指教 妹咕信箱