如何提取单元格内容并自动填写到对应的单元格里面

cnjade

函数版本已经有了第一种解决方案。http://club.excelhome.net/forum. ... p;extra=#pid5176964

AVEL

1. Option Explicit
   
2. Dim crr()
   
3. Dim i%
   
4. Sub l()
   
5.     Dim arr, brr
   
6.     Dim l%, str$, k$
   
7.     With Sheet1
   
8.         arr = .Range(.[a2], .[a2].End(4))
   
9.     End With
   
10.     ReDim crr(1 To UBound(arr), 1 To 18)
    
11.     For i = 1 To UBound(arr)
    
12.         str = Right(arr(i, 1), 1)
    
13.         If InStr(arr(i, 1), ",") Then
    
14.             brr = Split(arr(i, 1), ",")
    
15.             For l = 0 To UBound(brr)
    
16.                 If InStr(brr(l), "-") Then
    
17.                     Call zz(Split(brr(l), "-")(0), Split(brr(l), "-")(1))
    
18.                 Else
    
19.                     Call zz(brr(l), brr(l))
    
20.                 End If
    
21.             Next
    
22.         ElseIf str = "单" Or str = "双" Then
    
23.             brr = Split(arr(i, 1), "-")
    
24.             If str = "单" Then k = "单" Else If str = "双" Then k = "双"
    
25.             Call zz(brr(0), Left(brr(1), Len(brr(1)) - 1), k)
    
26.         ElseIf InStr(arr(i, 1), "-") Then
    
27.             brr = Split(arr(i, 1), "-")
    
28.             Call zz(brr(0), brr(1))
    
29.         Else
    
30.             Call zz(arr(i, 1), arr(i, 1))
    
31.         End If
    
32.     Next
    
33.     Sheet1.[b2].Resize(UBound(arr), 18).Value = crr
    
34. End Sub
    
35. Sub zz(ByVal x As Integer, ByVal y As Integer, Optional ds = "")
    
36. Dim j%
    
37. For j = x To y
    
38.     If ds = "" Then
    
39.         crr(i, j) = 1
    
40.     ElseIf ds = "单" Then
    
41.         If (j Mod 2) = 1 Then crr(i, j) = 1
    
42.     ElseIf ds = "双" Then
    
43.         If (j Mod 2) = 0 Then crr(i, j) = 1
    
44.     End If
    
45. Next
    
46. End Sub

复制代码

AVEL

测试附件看看。

cnjade

AVEL 发表于 2011-9-6 16:19
测试附件看看。

非常感谢AVEL，没有问题，我测试了一下。O(∩_∩)O哈哈~

cnjade

AVEL 发表于 2011-9-6 16:19
测试附件看看。

AVEL 早晨好
我运行时候发现出现type mismatch。不知道怎么回事。能帮忙看看么。
周数wk38.rar (34.4 KB, 下载次数: 7)

2011-9-21 10:29 上传

点击文件名下载附件

cnjade

我挨个删除，好像是 A175 影响的。 它的内容是 1-9,11-17单