[已解决]把一列中第一位相同的内容选出并复制到另一列

HNZZHGY · 发表于 2016-1-8 22:16

	123		701
	546		709
	701		789
	709		748
	910		721
	789		711
	A23
	345
	487		把一列中第一位相同的内容选出并复制到另一列(如把B列中的第一位为7的选出复制到D列）
	748
	987
	721
	656
	711

最佳答案

月排行榜 / 总排行榜

dsmch

2016-1-9 16:45

本帖最后由 dsmch 于 2016-1-9 18:46 编辑

Sub Macro1()
Dim arr, brr, i&, s&
arr = Range("b1").CurrentRegion
ReDim brr(1 To UBound(arr), 1 To 1)
[d:d] = ""
For i = 1 To UBound(arr)
If Left(arr(i, 1), 1) = "7" Then
s = s + 1
brr(s, 1) = arr(i, 1)
End If
Next
if s=1 then [d1] = brr(1, 1)
If s > 1 Then Range("d1").Resize(s) = brr
End Sub

复制代码

跳转到最佳答案楼层

lichuanboy44 · 发表于 2016-1-8 22:53

如果数据量不大，或者不经常进行同类似操作，最简单的办法是：数据排序后，人工分段处理。
反之，编程处理。

HNZZHGY · 发表于 2016-1-9 09:20

如何去做，编VBA也可以！

HNZZHGY · 发表于 2016-1-9 15:00

Sub tt2()
Dim R As Long
For R = 1 To Range("b65536").End(xlUp).Row
   If Left(Cells(R, 2), 1) = "7" Then
         Cells(R, 3) = Cells(R, 2)
      End If
Next R
End Sub

HNZZHGY · 发表于 2016-1-9 15:00

能达到以下效果
123
546
701 701
709 709
910
789 789
A23
345
487
748 748
987
721 721
656
711 711

HNZZHGY · 发表于 2016-1-9 15:01

达不到我要求的以下效果
123 701
546 709
701 789
709 748
910 721
789 711
A23
345
487
748
987
721
656
711
请高手帮忙修改

dsmch · 发表于 2016-1-9 16:45

本帖最后由 dsmch 于 2016-1-9 18:46 编辑

Sub Macro1()
Dim arr, brr, i&, s&
arr = Range("b1").CurrentRegion
ReDim brr(1 To UBound(arr), 1 To 1)
[d:d] = ""
For i = 1 To UBound(arr)
If Left(arr(i, 1), 1) = "7" Then
s = s + 1
brr(s, 1) = arr(i, 1)
End If
Next
if s=1 then [d1] = brr(1, 1)
If s > 1 Then Range("d1").Resize(s) = brr
End Sub

复制代码

dsmch · 发表于 2016-1-9 16:47

数据不多的话，四楼的代码稍加修改
Sub tt2()
Dim R As Long
For R = 1 To Range("b65536").End(xlUp).Row
   If Left(Cells(R, 2), 1) = "7" Then
         s=s+1
         Cells(s, 4) = Cells(R, 2)
      End If
Next R
End Sub

HNZZHGY · 发表于 2016-1-9 18:09

解决了，谢谢dsmch

HNZZHGY · 发表于 2016-1-10 12:09

为什么B列也就是数据前列有数据时不行
11 123 7
2 546
3 701
4 709
5 910
6 789
7 A23
8 345
9 487
10 748
11 987
12 721
13 656
14 711

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