2008/02/19

列名转换

VBA Code
Function ColumnLetter(ColumnNumber As Integer) As String
If ColumnNumber > 26 Then
ColumnLetter = Chr(Int((ColumnNumber - 1) / 26) + 64) & _
Chr(((ColumnNumber - 1) Mod 26) + 65)
Else
ColumnLetter = Chr(ColumnNumber + 64)
End If
End Function

Function ColumnNumber(ByVal ColumnLetter As String) As Integer
If Len(ColumnLetter) > 1 Then
ColumnNumber = (Asc(Mid(ColumnLetter, 1, 1)) - 64) * 26 +
(Asc(Mid(ColumnLetter, 2, 1)) - 64)
Else
ColumnNumber = Asc(ColumnLetter) - 64
End If
End Function

at

3 comments:

  1. AnonymousMay 11, 2008 at 9:53 PM

    Sub m1()
    Dim myRng As Range
    Dim myFlag As Byte '※１
    Dim myBoldCnt As Long, myRedCnt As Long
    Dim myBoldOrRedCnt As Long, myBoldAndRedCnt As Long

    For Each myRng In Range("B")
    myFlag = 0
    With myRng
    If .Font.Color = RGB(255, 0, 0) Then myFlag = myFlag + 1
    If .Font.Bold Then myFlag = myFlag + 2
    End With
    If myFlag And 1 Then myRedCnt = myRedCnt + 1
    If myFlag And 2 Then myBoldCnt = myBoldCnt + 1
    If myFlag And 3 Then myBoldOrRedCnt = myBoldOrRedCnt + 1
    If myFlag = 3 Then myBoldAndRedCnt = myBoldAndRedCnt + 1
    Next
    MsgBox "太字" & vbTab & vbTab & myBoldCnt & vbCrLf _
    & "赤" & vbTab & vbTab & myRedCnt & vbCrLf _
    & "太字または赤" & vbTab & myBoldOrRedCnt & vbCrLf _
    & "太字かつ赤" & vbTab & myBoldAndRedCnt

    End Sub

    ReplyDelete
  2. AnonymousMay 11, 2008 at 10:18 PM

    Sub test()
    Dim c As Range

    Application.ScreenUpdating = False
    For Each c In ActiveSheet.Range("B1:B1000")
    With c.Font
    If .Color = vbRed Then .Italic = True
    If .Bold Then .Color = vbRed

    End With
    Next
    Application.ScreenUpdating = True
    End Sub

    ReplyDelete
  3. AnonymousMay 11, 2008 at 10:23 PM

    excel统计 某个区域的红色字
    Sub test()
    Dim c As Range
    Dim myRedCnt As Long

    Application.ScreenUpdating = False
    For Each c In ActiveSheet.Range("B1:B1000")
    With c.Font
    If .Color = vbRed Then myRedCnt = myRedCnt + 1
    End With
    Next
    MsgBox "red word" & vbTab & vbTab & myRedCnt
    Application.ScreenUpdating = True
    End Sub

    ReplyDelete