[分享]***VBA程序交流***(更新中.....)。

jicqj · 发表于 2008-7-5 02:20

楼上的代码怎么用啊介绍一下。精神可嘉

maditate · 发表于 2008-7-5 07:48

光标上下左右移标本身不会引起重复吧，你所说的重复是什么意思能否清楚点。如果是单元格元格内容不允许与其它单元格重复的话也用不着写那么多代码。

JEFF13141988 · 发表于 2008-7-5 15:19

回复11楼：

此代码可能不是最简单的，除判断光标移动方向其他都是自己编写，用法是将此代码复制到工作表中就行。

Private Sub Worksheet_Change(ByVal Target As Range)

.....

End Sub

回复12楼：

光标上下左右移标是指Excel在输入数据时，选项中有光标移动选项，此代码是不管你的光标移动设置是向上、下、左、右对刚输入的数据判断在此列中是否有重复。

通常用于某列数据为唯一时有用如：员工代号，序列号等。

JEFF13141988 · 发表于 2008-7-5 15:53

行筛选，一般用于同一行有多数据重复，如下图：

RvjpJHxI.rar (11.27 KB, 下载次数: 2)

maditate · 发表于 2008-7-5 21:24

其实要判断刚输入的单元格中的字符在同行（同列）中是否有重复只需二三行代码就可以完成的，没必要搞的那么复杂。

xq1234 · 发表于 2008-7-5 23:21

数据转大写嘛,

[挑战]功能最全、最短（7行）的人民币大写函数 http://club.excelhome.net/viewthread.php?tid=143867&replyID=&skin=0,必须借助于EXCEL,但速度的确很快

如果脱离了EXCEL,我觉得下面的适用更广泛一些(原出处找不到了),因为以下这个函数无需借助EXCEL环境就能独立在VB代码中运行

' 试编写数字金额转中文大写的函数
' lin jin xiang 08-07-2004
' 重编辑 23-01-2005

Function DaXie(ByVal Num)       ' 人民币中文大写函数
    Application.Volatile True
    Place = "分角元拾佰仟万拾佰仟亿拾佰仟万"
    Dn = "壹贰叁肆伍陆柒捌玖"
    D1 = "整零元零零零万零零零亿零零零万"
    If Num < 0 Then FuHao = "（负）"
    Num = Format(Abs(Num), "###0.00") * 100
    If Num > 999999999999999# Then: DaXie = "数字超出转换范围!!": Exit Function
    If Num = 0 Then: DaXie = "零元": Exit Function
    NumA = Trim(Str(Num))
    NumLen = Len(NumA)
    For J = NumLen To 1 Step -1     ' 数字转换过程
      Temp = Val(Mid(NumA, NumLen - J + 1, 1))
      If Temp <> 0 Then             ' 非零数字转换
         NumC = NumC & Mid(Dn, Temp, 1) & Mid(Place, J, 1)
      Else                          ' 数字零的转换
         If Right(NumC, 1) <> "零" Then
           NumC = NumC & Mid(D1, J, 1)
         Else
           Select Case J            ' 特殊数位转换
                Case 1
                  NumC = Left(NumC, Len(NumC) - 1) & Mid(D1, J, 1)
                Case 3, 11
                  NumC = Left(NumC, Len(NumC) - 1) & Mid(D1, J, 1) & "零"
                Case 7
                  If Mid(NumC, Len(NumC) - 1, 1) <> "亿" Then
                     NumC = Left(NumC, Len(NumC) - 1) & Mid(D1, J, 1) & "零"
                  End If
                Case Else
           End Select
         End If
      End If
    Next
    DaXie = FuHao & Trim(NumC)
End Function

[此贴子已经被作者于2008-7-6 8:30:06编辑过]

JEFF13141988 · 发表于 2008-7-8 11:15

gR27R3px.rar (13.72 KB, 下载次数: 6)

除本人编写的外其他资料来自本网站。

[此贴子已经被作者于2008-7-8 11:29:35编辑过]

JEFF13141988 · 发表于 2008-7-8 12:30

下面是本人2001年用IF　FOR 两语句编写的金额大写函数，现在看来自己也汗言当时的蠢和勇气！

Public Function 大写(币种, 金额)
Dim v As Integer
Dim i As Integer
    If IsNumeric(金额) = False Then
    大写 = "#错误#"
    Exit Function
    End If
   金额 = Format(金额, "######0.00")
    If 金额 = "" Then
    大写 = "#错误#"
    Exit Function
    End If
v = Len(金额)
ReDim B(v)
ReDim m(v)
ReDim n(v)
    For i = 1 To v Step 1
    B(i) = Mid(金额, i, 1)
    'MsgBox b(i)
    Next
If B(1) = "-" Then
   If v > 13 Then
      MsgBox "数字太大，只能存亿位以内", vbCritical, "十亿以上无效"
      大写 = "#错误#"
      Exit Function
    End If
Else
    If v > 12 Then
      MsgBox "数字太大，只能存亿位以内", vbCritical, "十亿以上无效"
      大写 = "#错误#"
      Exit Function
    End If
End If

For i = 1 To v
If v - i = 11 Then      '亿位读数
     n(i) = "亿"
    If B(v - 11) <> 0 Then
     n(i) = "亿"
     End If
    If B(v - 10) = 0 And B(v - 9) <> 0 Or B(v - 10) = 0 And B(v - 8) <> 0 Or B(v - 10) = 0 And B(v - 7) <> 0 Or B(v - 10) = 0 And B(v - 6) <> 0 Then
      n(i) = "亿零"
    End If
        If B(v - 10) = 0 And B(v - 5) <> 0 Or B(v - 10) = 0 And B(v - 4) <> 0 Or B(v - 10) = 0 And B(v - 3) <> 0 Then
      n(i) = "亿零"
    End If

         If B(v - 10) = 0 And B(v - 9) = 0 And B(v - 8) = 0 And B(v - 7) = 0 And B(v - 6) = 0 And B(v - 5) = 0 And B(v - 4) = 0 And B(v - 3) = 0 Then
      n(i) = "亿"
    End If
    Else

If v - i = 10 Then        '仟万位读数
     n(i) = "仟"
    If B(v - 9) <> 0 Then
     n(i) = "仟"
     End If
    If B(v - 9) = 0 And B(v - 8) <> 0 Or B(v - 9) = 0 And B(v - 7) <> 0 Then
      n(i) = "仟零"
    End If
     If B(v - 9) = 0 And B(v - 8) = 0 And B(v - 7) = 0 And B(v - 6) <> 0 Or B(v - 9) = 0 And B(v - 8) = 0 And B(v - 7) = 0 And B(v - 5) <> 0 Then
      n(i) = "仟万零"
    End If
     If B(v - 9) = 0 And B(v - 8) = 0 And B(v - 7) = 0 And B(v - 4) <> 0 Or B(v - 9) = 0 And B(v - 8) = 0 And B(v - 7) = 0 And B(v - 3) <> 0 Then
      n(i) = "仟万零"
    End If
    If B(v - 9) = 0 And B(v - 8) = 0 And B(v - 7) = 0 And B(v - 6) = 0 And B(v - 5) = 0 And B(v - 4) = 0 And B(v - 3) = 0 Then
      n(i) = "仟万"
    End If
    Else

    If v - i = 9 Then              '佰万位读数
     n(i) = "佰"
    If B(v - 8) = 0 Then
     n(i) = "佰"
     End If
     If B(v - 8) = 0 And B(v - 7) <> 0 Then
     n(i) = "佰零"
     End If
     If B(v - 8) = 0 And B(v - 7) = 0 And B(v - 6) <> 0 Or B(v - 8) = 0 And B(v - 7) = 0 And B(v - 5) <> 0 Then
      n(i) = "佰万零"
    End If
     If B(v - 8) = 0 And B(v - 7) = 0 And B(v - 4) <> 0 Or B(v - 8) = 0 And B(v - 7) = 0 And B(v - 3) <> 0 Then
      n(i) = "佰万零"
    End If
    If B(v - 8) = 0 And B(v - 7) = 0 And B(v - 6) = 0 And B(v - 5) = 0 And B(v - 4) = 0 And B(v - 3) = 0 Then
      n(i) = "佰万"
    End If

    Else
    If v - i = 8 Then
     n(i) = "拾"
     If B(v - 7) = 0 Then
     n(i) = "拾万"
     End If
     If B(v - 7) = 0 And B(v - 3) <> 0 Or B(v - 7) = 0 And B(v - 4) <> 0 Then
      n(i) = "拾万零"
    End If
      If B(v - 7) = 0 And B(v - 5) <> 0 Or B(v - 7) = 0 And B(v - 6) <> 0 Then
      n(i) = "拾万零"
    End If
       If B(v - 7) = 0 And B(v - 6) = 0 And B(v - 5) = 0 And B(v - 4) = 0 And B(v - 3) = 0 Then
      n(i) = "拾万"
    End If
    Else
     If v - i = 7 Then
     n(i) = "万"
     If B(v - 6) = 0 Then
     n(i) = "万零"
       If B(v - 6) = 0 And B(v - 5) = 0 And B(v - 4) = 0 And B(v - 3) = 0 Then
      n(i) = "万"
    End If
    End If
    Else
     If v - i = 6 Then
      n(i) = "仟"
      If B(v - 5) = 0 Then
       n(i) = "仟零"
       End If
           If B(v - 5) = 0 And B(v - 4) = 0 And B(v - 3) <> 0 Then
      n(i) = "仟零"
    End If
           If B(v - 5) = 0 And B(v - 4) = 0 And B(v - 3) = 0 Then
      n(i) = "仟"
    End If
    Else
    If v - i = 5 Then
      n(i) = "佰"
      If B(v - 4) = 0 And B(v - 3) <> 0 Then
       n(i) = "佰零"
       End If
       Else
       If v - i = 4 Then
       n(i) = "拾"
       End If
       End If
       End If
       End If
       End If
       End If
       End If
       End If
If B(i) = 0 Then
        m(i) = "零"
         n(i) = ""
      For j = 1 To i
       If B(i - j) = 0 Then
         m(i) = ""
         n(i - j) = ""
        End If
      Next
Else
      If B(1) = "-" Then
        n(1) = "*" & "负" & "*"
      End If
     If B(i) = 0 Then
     m(i) = "零"
    End If
    If B(i) = 1 Then
     m(i) = "壹"
    End If
    If B(i) = 2 Then
     m(i) = "贰"
    End If
    If B(i) = 3 Then
      m(i) = "叁"
    End If
    If B(i) = 4 Then
      m(i) = "肆"
    End If
    If B(i) = 5 Then
      m(i) = "伍"
    End If
    If B(i) = 6 Then
      m(i) = "陆"
    End If
    If B(i) = 7 Then
      m(i) = "柒"
    End If
    If B(i) = 8 Then
      m(i) = "捌"
    End If
    If B(i) = 9 Then
      m(i) = "玖"
    End If
End If

If v - i = 2 Then
n(i) = "元"
End If
If v = 4 And B(1) = 0 Then
n(i) = ""
End If
If v - i > 1 Then
c = m(i) & n(i)
Else
c = ""
End If

大写 = 大写 & c
Next

If B(v) = 0 And B(v - 1) = 0 Then
n(v - 1) = ""
n(v) = "整"
Else
If B(v - 1) = 0 And B(v) <> 0 Then
n(v) = "分"
n(v - 1) = "零"
Else
If B(v - 1) <> 0 And B(v) = 0 Then
n(v) = ""
n(v - 1) = "角整"
Else

If B(v - 1) <> 0 And m(v) <> 0 Then
n(v) = "分"
n(v - 1) = "角"
End If
End If
End If
End If
If B(v - 3) = 0 Then
m(v - 3) = "零"
If B(v - 1) = 0 Then
n(v - 1) = ""
End If
If v = 4 And B(1) = 0 Then
m(v - 3) = ""
End If
If B(v - 3) = 0 And B(v - 1) = 0 And B(v) = 0 Then
m(v - 3) = ""
n(v - 1) = ""
End If
If v = 4 And B(v) = 0 And B(v - 1) = 0 And B(v - 3) = 0 Then
n(v) = "零"
End If
If v = 5 And B(1) = "-" And B(2) = 0 Then
m(v - 3) = ""
n(v - 2) = ""
大写 = "*" & "负" & "*"
End If
大写 = 大写 & m(v - 3) & m(v - 1) & n(v - 1) & m(v) & n(v)
Else
大写 = 大写 & m(v - 1) & n(v - 1) & m(v) & n(v)
End If

If 币种 = 1 Or 币种 = "RMB" Or 币种 = "CHY" Or Mid(币种, 1, 1) = "r" Or Mid(币种, 1, 1) = "c" Or Mid(币种, 1, 1) = "R" Or Mid(币种, 1, 1) = "C" Or Mid(币种, 1, 1) = "￥" Then
币种 = "人民币："
Else
If 币种 = 2 Or 币种 = "HK$" Or 币种 = "GB" Or Mid(币种, 1, 1) = "h" Or Mid(币种, 1, 1) = "G" Or Mid(币种, 1, 1) = "g" Or Mid(币种, 1, 1) = "H" Or Mid(币种, 1, 1) = "$" Then
币种 = "港币："
Else
If 币种 = 3 Or 币种 = "NT" Or 币种 = "TB" Or 币种 = "NT$" Or 币种 = "TWY" Or Mid(币种, 1, 1) = "T" Or Mid(币种, 1, 1) = "N" Then
币种 = "台币："
Else

币种 = 币种 & "："
End If
End If
End If
大写 = 币种 & 大写

End Functio

这是现在网上流行结合函数的金额大写函数

Function 金额大写(x As Range)
If x >= 1 Then
If Int(x) = x Or Round(x, 2) = Int(x) Then
金额大写 = Application.WorksheetFunction.Text(Int(x), "[DBNUM2]") & "元"

    ElseIf Int(x * 10) = x * 10 Or Int(x * 10) = Round(x, 2) * 10 Then
       金额大写 = Application.WorksheetFunction.Text(Int(x), "[DBNUM2]") & "元" & Application.WorksheetFunction.Text(Right(Round(x, 2), 1), "[DBNUM2]") & "角"
    Else
       金额大写 = Application.WorksheetFunction.Text(Int(x), "[DBNUM2]") & "元" & Application.WorksheetFunction.Text(Left(Right(Round(x, 2), 2), 1), "[DBNUM2]") & "角" & Application.WorksheetFunction.Text(Right(Round(x, 2), 1), "[DBNUM2]") & "分"
    End If
ElseIf x = 0 Then
    金额大写 = Application.WorksheetFunction.Text(Int(x), "[DBNUM2]") & "元"

ElseIf x < 1 And x > 0 Then

      If Int(x * 10) = x * 10 Then
       金额大写 = Application.WorksheetFunction.Text(Right(x, 1), "[DBNUM2]") & "角"
      Else
       金额大写 = Application.WorksheetFunction.Text(Left(Right(Round(x, 2), 2), 1), "[DBNUM2]") & "角" & Application.WorksheetFunction.Text(Right(Round(x, 2), 1), "[DBNUM2]") & "分"
      End If
Else
    If Int(x) = x Or Round(Abs(x), 2) = Int(Abs(x)) Then
       金额大写 = "负" & Application.WorksheetFunction.Text(Int(Abs(x)), "[DBNUM2]") & "元"

    ElseIf Int(x * 10) = x * 10 Then
       金额大写 = "负" & Application.WorksheetFunction.Text(Int(Abs(x)), "[DBNUM2]") & "元" & Application.WorksheetFunction.Text(Right(x, 1), "[DBNUM2]") & "角"
    Else
       金额大写 = "负" & Application.WorksheetFunction.Text(Int(Abs(x)), "[DBNUM2]") & "元" & Application.WorksheetFunction.Text(Left(Right(Round(x, 2), 2), 1), "[DBNUM2]") & "角" & Application.WorksheetFunction.Text(Right(Round(x, 2), 1), "[DBNUM2]") & "分"
    End If
End If
End Function

JEFF13141988 · 发表于 2008-8-4 14:09

在工作中经常在Excel工作表数对数据单元格进行颜色备注，备注多种颜色后很难将同一颜色的数据进行排序或筛选，在查看时很不方便，此颜色筛选能按颜色对单元格进行筛选，对颜色备注查看很方便。

AyQXeQrv.rar (8.33 KB, 下载次数: 9)

[此贴子已经被作者于2008-8-4 14:16:30编辑过]

chen7806 · 发表于 2008-8-4 14:47

QUOTE:

以下是引用JEFF13141988在2008-7-3 21:35:53的发言：

101,001,101.50

人民币：壹亿零壹佰万壹仟壹佰零壹元伍角整

人民币：壹亿零壹佰万零壹仟壹佰零壹元伍角整

　　　哪个读数更准确？

当然是第一个了。

100万后面肯定是千了。还要什么零？

		自动登录	找回密码
密码			免费注册

[分享]VBA程序交流(更新中.....)。

[分享]在工具栏中添加工作表目录

[分享]金额大写函数

[分享]按单元格背影颜色筛选