求助，利用excel vba提取数据库数据问题

1、汉字在前，数字在后面的情形。可以用MID，min， find三个函数来实现提取里面的数字。如图：在B2输入“=MID(A1，MIN(FIND({0，1，2，3，4，5，6，7，8，9}，A1&“0123456789”))，20)”

2 、把单元格里面所有的数字都提出来。可以使用宏。先打开VBA编辑器。工具——宏——visual basic 编辑器

3、在编辑器里点击插入——模块。在模块那里输入如下代码：

Function zzsz(xStr As String) As StringDim i As IntegerFor i = 1 To Len(xStr)If IsNumeric(Mid(xStr， i， 1)) Then zzsz = zzsz &Mid(xStr， i， 1)NextEnd Function

4、回到工作表，在B2单元格那里输入“=zzsz(A2)”。就可以用VBA把A2单元格里所有的数字都提取出来了，如图所示。

Excel怎么只提取表格中的数字

5、指定从第几个数组提取开始。也就是说在不连续的那些数字中，从第几次出现的数组开始提取。同样在模块那里输入如下代码：

Function GetNums(rCell As Range， num As Integer) As StringDim Arr1() As String， Arr2() As StringDim chr As String， Str As StringDim i As Integer， j As IntegerOn Error GoTo line1

Str = rCell.TextFor i = 1 To Len(Str)chr = Mid(Str， i， 1)If (Asc(chr) 《 48 Or Asc(chr) 》 57) ThenStr = Replace(Str， chr， “ ”)End IfNext

Arr1 = Split(Trim(Str))ReDim Arr2(UBound(Arr1))For i = 0 To UBound(Arr1)If Arr1(i) 《》 “” ThenArr2(j) = Arr1(i)j = j + 1End IfNext

GetNums = IIf(num 《= j， Arr2(num - 1)， “”)line1:End Function

要调用某个CELL的数据，可以在VBA中写：（假设是B3单元）

Dim temp As String

...

temp = Range("B3").Value 或 temp = Cells(3,2).Value 或 temp = Cells(3, "B")

这里，即使EXCEL表格里是数字，到了VBA里面还是变成字符串。

然后，再判断temp的内容，用 if...then... 语句就可以了：

......

If temp = "yes" Then

.....

Else

If temp = "no" Then

.....

Else

.....

End If

End If

......

语句不多，好像没有必要写一个SUB TEXT()。

例子数据源：

程序代码：

运行结果：

是不是很完美，程序文本：

Option Explicit

Sub 转换()

  Dim a1, a2(1 To 1000, 1 To 100), i, j, x, y, m, n

  Set x = CreateObject("Scripting.Dictionary")

  Set y = CreateObject("Scripting.Dictionary")

  a1 = Range("a1").CurrentRegion

  For i = 1 To UBound(a1)

      If a1(i, 1) = "价格" Then

          If Not y.Exists(a1(i, 2)) Then

              a2(1, y.Count + 2) = a1(i, 2)

              y.Add a1(i, 2), y.Count + 2

          End If

          n = y(a1(i, 2))

      Else

          If Not x.Exists(a1(i, 1)) Then

              a2(x.Count + 2, 1) = a1(i, 1)

              x.Add a1(i, 1), x.Count + 2

          End If

          m = x(a1(i, 1))

          a2(m, n) = a1(i, 2)

      End If

  Next i

  Range("d1").Resize(x.Count + 1, y.Count + 1) = a2

End Sub

---