请问怎么根据栋号房号来自动分配抄表员

mohao · 发表于 2010-11-10 17:42

请问怎么根据栋号房号来自动分配抄表员

excelflower · 发表于 2010-11-10 18:54

用公式，行不？

excelflower对应公式.rar (15.57 KB, 下载次数: 8)
（你的“数据源”，要修改，见附件。）

excelflower · 发表于 2010-11-10 19:07

用VBA

EHflower对应公式.rar (27.89 KB, 下载次数: 12) ，你的“数据源”也要规范。

Private Sub CommandButton1_Click()
Dim i&, j&, StrA$, StrB$
For i = 2 To Range("c" & Rows.Count).End(3).Row
StrA = Range("d" & i) & Range("e" & i) & Right(Range("f" & i), 1)
For j = 3 To Range("m" & Rows.Count).End(3).Row
StrB = Range("m" & j) & Range("n" & j) & Range("o" & j)
If StrA = StrB Then
Range("k" & i).Value = Range("p" & j)
End If
Next j
Next i
MsgBox ("搞好了！")
End Sub

复制代码

mohao · 发表于 2010-11-10 23:22

谢谢，但如果要修改数据源的话，工作量也太大了

excelflower · 发表于 2010-11-10 23:47

原帖由 mohao 于 2010-11-10 23:22 发表
谢谢，但如果要修改数据源的话，工作量也太大了

可以用VBA来修改

也可以用VBA直接实现功能。不过，还是规范一下“数据源”比较好

mohao · 发表于 2010-11-11 06:54

请问怎么可以快捷，方便的规范一下“数据源”？

excelflower · 发表于 2010-11-11 19:27

原帖由 mohao 于 2010-11-11 06:54 发表
请问怎么可以快捷，方便的规范一下“数据源”？

云南昆明的吧！与昆明有缘啊！可以帮你搞啊，等等我啊，现在忙着呢

excelflower · 发表于 2010-11-11 20:44

先试试这个

Sub flower()
Dim i&, j&, k&, m&, n&, StrA$, StrB$, StrC$, StrD$
Application.ScreenUpdating = False
Application.Calculation = xlManual
For i = Range("n65536").End(3).Row To 3 Step -1
k = 1 '栋号列N
StrA = Range("n" & i).Value '栋号列N
j = InStr(1, StrA, "、") '栋号列N
m = 1 '房号列O
StrC = Range("o" & i).Value '房号列O
n = InStr(1, StrC, "、") '房号列O
If j > 0 Then
StrB = Mid(StrA, 1, j - 1)
Range("m" & i + 1 & ":p" & i + 1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("m" & i + 1 & ":p" & i + 1).Value = Range("m" & i & ":p" & i).Value
Range("n" & i).Value = StrB
Range("n" & i + 1).Value = Mid(StrA, j + 1, Len(StrA))
ElseIf n > 0 Then
StrD = Mid(StrC, 1, n - 1)
Range("m" & i + 1 & ":p" & i + 1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("m" & i + 1 & ":p" & i + 1).Value = Range("m" & i & ":p" & i).Value
Range("o" & i).Value = StrD
Range("o" & i + 1).Value = Mid(StrC, n + 1, Len(StrC))
End If
Next i
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

复制代码

mohao · 发表于 2010-11-11 23:25

什么感谢 excelflower 兄弟，但规范栋号之后，如果房号那不输入数字的话，就不能分配抄表员了。

ericjon · 发表于 2010-11-12 09:11

Sub distribute()
Dim rge, vt1, vt2, roomNo, buildNo
Dim i%, j%, k%, n%

Set rge = Range(Range("D2:K2"), Range("D2:K2").End(xlDown))
vt1 = rge
vt2 = Range(Range("M3:P3"), Range("M3:P3").End(xlDown))

For i = 1 To UBound(vt1, 1)
      rge(i, 8).ClearContents
      roomNo = Right(vt1(i, 3), 1)
      For j = 1 To UBound(vt2, 1)
         If vt1(i, 2) = vt2(j, 2) Then
            If vt2(j, 3) <> "" Then
                  If vt1(i, 1) = vt2(j, 1) And vt2(j, 3) Like "*" & roomNo & "*" Then
                     rge(i, 8) = vt2(j, 4)
                     Exit For
                  End If
            ElseIf vt1(i, 1) = vt2(j, 1) Then
                  rge(i, 8) = vt2(j, 4)
                  Exit For
            End If
         Else
            If vt1(i, 1) = vt2(j, 1) And vt2(j, 2) Like "*" & vt1(i, 2) & "*" Then
                  rge(i, 8) = vt2(j, 4)
                  Exit For
            End If
         End If
      Next
Next

End Sub

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

[求助] 请问怎么根据栋号房号来自动分配抄表员