A列和B列为基础数据，利用VBA，生成右侧结果，用逗号分隔。
最好将结果另存为txt的格式。
非常着急，我有多少分就加多少分了，请赐教！
第1个回答 2011-01-06
可以利用字典
也可以利用数组
也可以利用ADO
来实现
用字典帮你做一个
Sub OkExcelDictionary()
'智能Excel网站提供
Dim d As Object
Dim WeekStr As Variant
Dim r As Range
Dim i As Integer
Set d = CreateObject("Scripting.Dictionary")
Set r = Worksheets(1).Range("A1")
WeekStr = Split("星期一,星期二,星期三,星期四,星期五,星期六,星期日", ",")
Do While r.Text <> ""
If d.exists(r.Text) Then
d.Item(r.Text) = d.Item(r.Text) & "," & r.Offset(0, 1).Text
Else
d.Add r.Text, r.Offset(0, 1).Text
End If
Set r = r.Offset(1, 0)
Loop
Set r = Worksheets(2).Range("A1")
For i = 0 To 6
r.Value = WeekStr(i) & IIf(d.exists(WeekStr(i)), "," & d.Item(WeekStr(i)), "")
Set r = r.Offset(1, 0)
Next
d.RemoveAll
Set r = Nothing: Set d = Nothing
End Sub
也可以利用数组
也可以利用ADO
来实现
用字典帮你做一个
Sub OkExcelDictionary()
'智能Excel网站提供
Dim d As Object
Dim WeekStr As Variant
Dim r As Range
Dim i As Integer
Set d = CreateObject("Scripting.Dictionary")
Set r = Worksheets(1).Range("A1")
WeekStr = Split("星期一,星期二,星期三,星期四,星期五,星期六,星期日", ",")
Do While r.Text <> ""
If d.exists(r.Text) Then
d.Item(r.Text) = d.Item(r.Text) & "," & r.Offset(0, 1).Text
Else
d.Add r.Text, r.Offset(0, 1).Text
End If
Set r = r.Offset(1, 0)
Loop
Set r = Worksheets(2).Range("A1")
For i = 0 To 6
r.Value = WeekStr(i) & IIf(d.exists(WeekStr(i)), "," & d.Item(WeekStr(i)), "")
Set r = r.Offset(1, 0)
Next
d.RemoveAll
Set r = Nothing: Set d = Nothing
End Sub
第2个回答 2011-01-05
Sub aa()
For j = 1 To 7
m = ""
Select Case j
Case 1
x = "星期一"
Case 2
x = "星期二"
Case 3
x = "星期三"
Case 4
x = "星期四"
Case 5
x = "星期五"
Case 6
x = "星期六"
Case 7
x = "星期日"
End Select
For i = 1 To 1000 '根据列的长度
If Cells(i, 1) = "" Then GoTo 10
If Cells(i, 1) = x Then
n = Cells(i, 2)
m = m & "," & n
End If
Next
10 Cells(j, 4) = x & m
Next
End Sub本回答被提问者和网友采纳
For j = 1 To 7
m = ""
Select Case j
Case 1
x = "星期一"
Case 2
x = "星期二"
Case 3
x = "星期三"
Case 4
x = "星期四"
Case 5
x = "星期五"
Case 6
x = "星期六"
Case 7
x = "星期日"
End Select
For i = 1 To 1000 '根据列的长度
If Cells(i, 1) = "" Then GoTo 10
If Cells(i, 1) = x Then
n = Cells(i, 2)
m = m & "," & n
End If
Next
10 Cells(j, 4) = x & m
Next
End Sub本回答被提问者和网友采纳
第3个回答 2011-01-04
我可以做啊。不过就给0分啊。。。
