2009年5月アーカイブ

binary

ascii

ftp>lcd

ftp>pwd

quote site chmod 707　ディレクトリ名

ftp>cd Sites/takenote

ftp>dir

ftp>open ftp.adg.bne.jp

quit

bye

ftp>delete ファイル名

ftp>put C:\data.txt

>cd C:\data

>cd myfolder

>cd ../

Format(Cells(L, C).Value, "##,###")

If T = 51 Then
	Head = "大:"
ElseIf T = 52 Then
	Head = "小:"
ElseIf T = 53 Then
	Head = "サブ1:"
ElseIf T = 54 Then
	Head = "サブ2:"
ElseIf T = 55 Then
	Head = "サブ3:"
End If

mystr = "たけうち　とおる" 
myArray = Split(mystr, "　") 

'名字 
MsgBox (myArray(0)) 
'名前 
MsgBox (myArray(1))

mystr = "0123456789" 
midStr = Mid(mystr, 2, 5) 
MsgBox (midStr) 

buf2 = Left(Cells(N, 3), 5)

long = InStr([start, ]targetstring, serchstring[, compare])

        For C = 5 To MaxCellCount
            '処理
        Next

        For C = 5 To MaxCellCount Step 2 
            '処理
        Next

    loopendcount = 0
    Do While loopendcount < 20
        If Sheets(motoSheet).Cells(L + 1, 7).Value = "" Then
            loopendcount = loopendcount + 1
        Else
            loopendcount = 0
        End If
        '処理をかく
        L = L + 1
    Loop

    L = 2 '初期値
    Do While Cells(L , 1).Value <> ""
         'イロイロ処理をする
        L = L + 1
    Loop

Sub 列の幅()
    ActiveSheet.Columns(1).ColumnWidth = 3
End Sub

Sub 名前をつけて保存()
    ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & ":test.xls"
End Sub

Sub 名前をつけて保存()
    ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\test.xls"
End Sub

Sub A1を含む表に処理をする()
    Dim i, rowCount As Integer
    rowCount = ActiveSheet.Range("A1").CurrentRegion.Rows.Count
    For i = 1 To rowCount
        ActiveSheet.Range("A1").CurrentRegion.Rows(i).Value = i
    Next
End Sub

Application.WorksheetFunction.Round(Cells(1, 2).Value, ●)

Application.WorksheetFunction.RoundUP(Cells(1, 2).Value, ●)

Application.WorksheetFunction.RoundDown(Cells(1, 2).Value, ●)

Sub 四捨五入()
    Cells(1, 1).Value = Application.WorksheetFunction.Round(Cells(1, 2).Value, 3)
End Sub

Rows(L).Insert Shift:=xlDown

N = FreeFile
Open "Macintosh HD:excel:" + "売価.txt" For Output As #N
Print #N, baika
Close #N

Cells(N, 2).NumberFormatLocal = "@"

Sub セルが数値なら()
    If IsNumeric(Cells(3, 1).Value) = True Then
        Cells(3, 1).Interior.ColorIndex = 6
    End If
End Sub

Sub セルが空なら()
    If IsEmpty(Cells(2, 1).Value) = True Then
        Cells(2, 1).Interior.ColorIndex = 6
    End If
End Sub

    motoSheet = ActiveSheet.Name
    Sheets.Add
    ActiveSheet.Name = "step2"
    
    For C = 1 To 45
        Sheets("step2").Cells(C).ColumnWidth = Sheets(motoSheet).Cells(C).ColumnWidth
        Sheets("step2").Cells(C).NumberFormatLocal = Sheets(motoSheet).Cells(C).NumberFormatLocal
        Sheets("step2").Cells(C).VerticalAlignment = Sheets(motoSheet).Cells(C).VerticalAlignment
    Next

Sheets("step2").Select

mystr = Cells(L, 1).Value
num = InStr(mystr, "　")
If num = 0 Then
    Lstr = ""
     Rstr = mystr
Else
     Lstr = Left(mystr, num - 1)
     Rstr = Mid(mystr, num + 1)
End If
Cells(L, 2).Value = Lstr
Cells(L, 3).Value = Rstr

Sub 入力ボックスを出す()
    Dim N As Integer
    N = Application.InputBox(prompt:="入力", Title:="タイトル", Default:=1, Type:=1)
    Cells(1, 1).Value = N
End Sub

Sub 同じのに印()
	Dim N, T As Integer
	Dim buf1, buf2, buf3 As String
		For N = 2 To 1000
			buf1 = Cells(N - 1, 3)
			buf2 = Cells(N, 3)
			If buf2 = buf1 Then
				Cells(N - 1, 1) = "■完全一致"
				Cells(N, 1) = "■完全一致"
			End If
		Next
End Sub

Sub 同じの外す()
	Dim N, T As Integer
	Dim buf1, buf2, buf3 As String
		For N = 2 To 1000
			buf1 = Left(Cells(N - 1, 2), 4)
			buf2 = Left(Cells(N, 2), 4)
			buf3 = Left(Cells(N + 1, 2), 4)
			If buf2 <> buf1 And buf2 <> buf3 Then
				Cells(N, 2) = "同じでない：" + Cells(N, 2)
			End If
		Next
End Sub

Sub setcolor()
    Dim L As Integer
    Dim goukei As Long
    L = 1 '初期値
    Do While Cells(L + 1, 1).Value <> ""'E列に何か入っている間繰り返す。
        If IsNumeric(Cells(L, 5)) Then'数値なら
            If Cells(L, 5) < 10 Then
                Cells(L, 5).Interior.ColorIndex = xlNone
            ElseIf 9 < Cells(L, 5) And Cells(L, 5) < 20 Then
                Cells(L, 5).Interior.ColorIndex = 36
                'Cells(L, 5).Interior.Pattern = xlSolid
                'Cells(L, 5).Interior.PatternColorIndex = xlAutomatic
            ElseIf 19 < Cells(L, 5) And Cells(L, 5) < 30 Then
                Cells(L, 5).Interior.ColorIndex = 6
                'Cells(L, 5).Interior.Pattern = xlSolid
                'Cells(L, 5).Interior.PatternColorIndex = xlAutomatic
            ElseIf 29 < Cells(L, 5) And Cells(L, 5) < 40 Then
                Cells(L, 5).Interior.ColorIndex = 44
                'Cells(L, 5).Interior.Pattern = xlSolid
                'Cells(L, 5).Interior.PatternColorIndex = xlAutomatic
            ElseIf 39 < Cells(L, 5) And Cells(L, 5) < 100 Then
                Cells(L, 5).Interior.ColorIndex = 45
                'Cells(L, 5).Interior.Pattern = xlSolid
                'Cells(L, 5).Interior.PatternColorIndex = xlAutomatic
            End If
        Else
                Cells(L, 5).Interior.ColorIndex = xlNone
        End If
        L = L + 1
    Loop
End Sub

Sub 合体FG()
	Dim N As Integer
	Dim buf As String
	For N = 1 To 525
		If Cells(N, 6) = "" Then
			Cells(N, 6) = Cells(N, 7)
		ElseIf Cells(N, 7) = "" Then
			Cells(N, 6) = Cells(N, 6)
		Else
			Cells(N, 6) = Cells(N, 6) + "
" + Cells(N, 7)
		End If
	Next
End Sub

Sub 特定のセルに文字を追加()
	Dim N, T As Integer
	Dim buf, Head As String
	T = 51
	For T = 1 To 5
		If T = 1 Then
			Head = "大:"
		ElseIf T = 2 Then
			Head = "小:"
		ElseIf T = 3 Then
			Head = "サブ1:"
		ElseIf T = 4 Then
			Head = "サブ2:"
		ElseIf T = 5 Then
			Head = "サブ3:"
		End If
		For N = 2 To 525
			'MsgBox (Cells(N, T))
			If Str(Cells(N, T)) = "0" Then
				'MsgBox (Str(N) + "/" + Str(T))
			ElseIf Cells(N, T) = 0 Then
			
			Else
				Cells(N, T) = Head + Str(Cells(N, T))
			End If
		Next
	Next

End Sub

Sub かぶり削除()
    Dim L As Integer
    L = 414 '初期値
    Do While L > 1
        'MsgBox Cells(L, 2).Value
        If Cells(L, 2).Value = Cells(L - 1, 2).Value Then
            'Cells(L - 1, 9).Value = Cells(L, 8).Value
            Rows(L).Delete Shift:=xlUp
        End If
        L = L - 1
    Loop
End Sub

Sub 合体()
    Dim L, C, OldL, OldC2 As Integer
    Dim oldvalue As String
    L = 2 '初期値
    OldL = 1
    oldvalue = Cells(1, 1)
    Do While Cells(L + 1, 1).Value <> ""
        If oldvalue = Cells(L, 1).Value Then
            C = 2
            OldC2 = 2
            '空いているところを見つける
            Do While Cells(OldL, OldC2).Value <> ""
                OldC2 = OldC2 + 1
            Loop
            Do While Cells(L, C).Value <> ""
                Cells(OldL, OldC2).Value = Cells(L, C).Value
                OldC2 = OldC2 + 1
                C = C + 1
            Loop
        Else
            oldvalue = Cells(L, 1)
            OldL = L
        End If
        L = L + 1
    Loop
End Sub