查找汉字 [一-龥] 的操作求助！！

网名

我有一个数据表，里面是很乱的数据，


排列出下：
          A         B            C                 D         E          F         G              H            I           J                K           L          M          N           O          P             Q
  1 0555     你好   135555555     1.22     1.22     200     2222      123456   你们   1377777      1122    222.0     52.1    15566    大家   1366666    。。数据很多，以下省略。。。


有没有什么办法能自动查找数据中的汉字，将汉字前一行对应的数值，和汉字后一行对应的数据复制到表2的A列中 如下。。。
   
         A         B             C
1   0555     你好    135555555
2  123456 你们      1377777
3  15566   大家      1366666

。。。。。。以下省略

win2009

没附件，不行吧

网名

win2009 发表于 2012-10-17 11:47
没附件，不行吧

附件已上传，谢谢你的关注！

win2009

查找汉字 [一-龥] 的操作求助.rar (10.26 KB, 下载次数: 42)

2012-10-17 12:38 上传

点击文件名下载附件

Public Sub fghgfh()
    [a18].Resize(100, 1).ClearContents
    On Error Resume Next
    Dim Arr
    Set d = CreateObject("Scripting.Dictionary")
    Arr = Sheet1.[a1].CurrentRegion
    For i = 1 To UBound(Arr)
        For j = 1 To UBound(Arr, 2)
            If Arr(i, j) Like "*[一-龥]*" Then
                d(Arr(i, j - 1) & "|" & Arr(i, j) & "|" & Arr(i, j + 1)) = ""
            End If
        Next
    Next
    [a18].Resize(d.Count, 1) = Application.Transpose(d.Keys)
End Sub

公有的 过程 fghgfh()
    [a18] . 重调大小(100 ,1) . 清除内容
    当 错误 转到 下一句
    定义变量 arr
    设置 d = 创建对象(脚本语言 . 字典)
    arr = 工作表1 . [a1] . 当前区域
    循环范围 i = 1 到 数组上限(arr)
        循环范围 j = 1 到 数组上限(arr ,2)
            如果 arr(i ,j) 类似 "*[一-龥]*" 那么
                d(arr(i ,j - 1) & "|" & arr(i ,j) & "|" & arr(i ,j + 1)) = ""
            结束 如果
        下一句
    下一句
    [a18] . 重调大小(d . 计数值 ,1) = 应用程序 . 区域转置(d . 关键字)
结束 过程

网名

win2009 发表于 2012-10-17 12:34
Public Sub fghgfh()
    [a18].Resize(100, 1).ClearContents
    On Error Resume Next

高手！非常感谢！

网名

win2009 发表于 2012-10-17 12:34
Public Sub fghgfh()
    [a18].Resize(100, 1).ClearContents
    On Error Resume Next

这个代码不能提取在14行以下的信息，如何修改成能提取到30行以内的数据呢？

win2009

网名 发表于 2012-10-17 16:00
这个代码不能提取在14行以下的信息，如何修改成能提取到30行以内的数据呢？

Public Sub fghgfh()
   Sheet2. [a2].Resize(100, 1).ClearContents
    On Error Resume Next
    Dim Arr
    Set d = CreateObject("Scripting.Dictionary")
    Arr = Sheet1.[a1].CurrentRegion
    For i = 1 To UBound(Arr)
        For j = 1 To UBound(Arr, 2)
            If Arr(i, j) Like "*[一-龥]*" Then
                d(Arr(i, j - 1) & "|" & Arr(i, j) & "|" & Arr(i, j + 1)) = ""
            End If
        Next
    Next
   Sheet2. [a2].Resize(d.Count, 1) = Application.Transpose(d.Keys)
End Sub

brianlong

win2009 发表于 2012-10-17 12:34
Public Sub fghgfh()
    [a18].Resize(100, 1).ClearContents
    On Error Resume Next

第一回见还有人这么仔细的特意加了解释  给你点个赞

huyuqun

brianlong 发表于 2018-7-16 11:06
第一回见还有人这么仔细的特意加了解释  给你点个赞

第一回见还有人这么仔细的特意加了解释  给你点个赞

Learner2022

学到了学到了 like这个用法以前还没用过这个