[已解决]批量 提取奇偶数列的值的VBA代码如何写?

学习学习vba

如图所示...


按钮-奇提取,意思是 把B列 含有奇数的 对应的单元格的数据提取出来,写到表格根目录下的1.txt文件里

同理,

按钮-偶提取,意思是 把B列 含有偶数的 对应的单元格的数据提取出来,写到表格根目录下的2.txt文件里


例子:奇提取

B列的 B2=1,B5=33,B7=55,B8=999,B9=3,B11=3,B13=7 这些都是奇数
提取其对应A列的数据,
B2=1,    A2=华
B5=33,   A5=共
B7=55,   A7=国
B8=999,  A8=01 99
B9=3,    A9=123
B11=3,   A11=asdf
B13=7    A13=er

把依次提取到的A列的数据写入1.txt

1.txt内容如下

华
共
国
01 99
123
asdf
er

附件下载: 20141207.rar (81.94 KB, 下载次数: 6)

2014-12-7 13:38 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

xdragon

2014-12-7 15:39

1. Sub ToText(Optional 奇偶 As Boolean) '奇数=False ； 偶数=True
   
2.      Dim arr, i&
   
3.      arr = Range("A1:B" & Cells(Rows.Count, 1).End(xlUp).Row).Value
   
4.      Open ThisWorkbook.Path & "\1.txt" For Append As #1
   
5.      For i = 1 To UBound(arr)
   
6.          If arr(i, 2) Mod 2 = 1 + 奇偶 Then Print #1, arr(i, 1)
   
7.      Next
   
8.      Close #1
   
9. End Sub
   
10. 
    
11. Sub 奇数()
    
12.     Call ToText(False)
    
13. End Sub
    
14. 
    
15. Sub 偶数()
    
16.     Call ToText(True)
    
17. End Sub

复制代码

好像忘记改了稍微改一个地方就好了

跳转到最佳答案楼层

xdragon

1. Sub ToText(Optional 奇偶 As Boolean) '奇数=False ； 偶数=True
   
2.      Dim arr, i&
   
3.      arr = Range("A1:B" & Cells(Rows.Count, 1).End(xlUp).Row).Value
   
4.      Open ThisWorkbook.Path & "\1.txt" For Append As #1
   
5.      For i = 1 To UBound(arr)
   
6.          If arr(i, 2) Mod 2 = 2 + 奇偶 Then Print #1, arr(i, 1)
   
7.      Next
   
8.      Close #1
   
9. End Sub
   
10. 
    
11. Sub 奇数()
    
12.     Call ToText(False)
    
13. End Sub
    
14. 
    
15. Sub 偶数()
    
16.     Call ToText(True)
    
17. End Sub

复制代码

学习学习vba

xdragon 发表于 2014-12-7 14:20

老师好
奇数的 提取 失败..

xdragon

1. Sub ToText(Optional 奇偶 As Boolean) '奇数=False ； 偶数=True
   
2.      Dim arr, i&
   
3.      arr = Range("A1:B" & Cells(Rows.Count, 1).End(xlUp).Row).Value
   
4.      Open ThisWorkbook.Path & "\1.txt" For Append As #1
   
5.      For i = 1 To UBound(arr)
   
6.          If arr(i, 2) Mod 2 = 1 + 奇偶 Then Print #1, arr(i, 1)
   
7.      Next
   
8.      Close #1
   
9. End Sub
   
10. 
    
11. Sub 奇数()
    
12.     Call ToText(False)
    
13. End Sub
    
14. 
    
15. Sub 偶数()
    
16.     Call ToText(True)
    
17. End Sub

复制代码

好像忘记改了稍微改一个地方就好了