[已解决]求大侠帮忙写个取值的VBA

teddyjin1984 · 发表于 2015-12-15 23:43

本帖最后由 teddyjin1984 于 2015-12-16 12:48 编辑

要求：根据"数据"表中的工作令编号取值，"取样"C5="数据"E5,D5=B5,E5=I6,F5=G23,H5=B8-B15,I5=F8-F15,J5=H8-H15,K5=G8-G15,R5=B17,S5=F17,T5=I17,然后在取值表中能一键取值。

最佳答案

月排行榜 / 总排行榜

爱疯

2015-12-16 12:37

取值3.rar (58.75 KB, 下载次数: 10)

爱疯 · 发表于 2015-12-16 09:18

Sub test()
Dim r As Integer
r = Sheets(1).Cells(Rows.Count, 1).End(3).Row + 1
Sheets(1).Cells(r, "C") = Sheets(2).[E5]
Sheets(1).Cells(r, "D") = Sheets(2).[B5]
'自行补足对应关系
End Sub

剩下的，你照着写就可以了

sry660 · 发表于 2015-12-16 09:30

根据你的描述写出了代码，但是你的描述应该是有些问题的，做数据运算的单元格内容并非数据，请重新核实下，然后对代码进行相应调整即可

Sub 取值()
Dim iRow&, i&, Sht As Worksheet
Set Sht = Sheets(2)
Sheets(1).Activate
[c5:u100].ClearContents
iRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
Range("c" & iRow) = Sht.[e5].Value
Range("d" & iRow) = Sht.[b5].Value
Range("e" & iRow) = Sht.[i6].Value
Range("f" & iRow) = Sht.[g23].Value
Range("h" & iRow) = Sht.[b8].Value - Sht.[b15].Value
Range("i" & iRow) = Sht.[f8].Value - Sht.[f15].Value
Range("j" & iRow) = Sht.[h8].Value - Sht.[h15].Value
Range("k" & iRow) = Sht.[g8].Value - Sht.[g15].Value
Range("r" & iRow) = Sht.[b17].Value
Range("s" & iRow) = Sht.[f17].Value
Range("t" & iRow) = Sht.[i17].Value
End Sub

复制代码

teddyjin1984 · 发表于 2015-12-16 11:09

爱疯发表于 2015-12-16 09:18
Sub test()
Dim r As Integer
r = Sheets(1).Cells(Rows.Count, 1).End(3).Row + 1

取值是可以了，但是没有能取到8-15行的内容，只能取到一行，我要一次取到所有的，效果看下我发的图

teddyjin1984 · 发表于 2015-12-16 11:15

sry660 发表于 2015-12-16 09:30
根据你的描述写出了代码，但是你的描述应该是有些问题的，做数据运算的单元格内容并非数据，请重新核实下， ...

我要这样的效果，然后日期忘记了，日期也要。

爱疯 · 发表于 2015-12-16 11:49

Sub test3()
Dim A, B(1 To 1, 1 To 21), i, j, r, bol As Boolean
A = Sheets(2).UsedRange '填写表

For i = 8 To 15

      '1）先预览，如果该行有空值，就不添加
      bol = True
      If A(i, 2) = "" Or A(i, 4) = "" Or A(i, 6) = "" Or _
         A(i, 7) = "" Or A(i, 8) = "" Or A(i, 9) = "" Or _
         A(i, 10) = "" Or A(8, 11) = "" Then bol = False: Exit For

      '2）数据齐全，才添加
      If bol Then
         B(1, 1) = Month(A(8, 11))
         B(1, 2) = Day(A(8, 11))
         B(1, 3) = A(5, 5)
         B(1, 4) = A(2, 5)
         B(1, 5) = A(6, 10)

         B(1, 6) = A(23, 7)
         B(1, 7) = ""
         B(1, 8) = A(i, 2)
         B(1, 9) = A(i, 4) & "/" & A(i, 6)
         B(1, 10) = A(i, 8)

         B(1, 11) = A(i, 7)
         B(1, 12) = ""
         B(1, 13) = ""
         B(1, 14) = ""
         B(1, 15) = ""

         B(1, 16) = ""
         B(1, 17) = ""
         B(1, 18) = A(17, 2)
         B(1, 19) = A(17, 5)
         B(1, 20) = A(17, 9)
         B(1, 21) = ""

         With Sheets(1)
            r = .Cells(Rows.Count, "B").End(3).Row '数据表最后一行
            .Rows(r + 1 & ":" & Rows.Count).ClearContents
            .Cells(r + 1, 1).Resize(1, UBound(B, 2)) = B
         End With
      End If

Next i

End Sub

取值2.rar (58.67 KB, 下载次数: 4)

teddyjin1984 · 发表于 2015-12-16 12:26

爱疯发表于 2015-12-16 11:49
Sub test3()
Dim A, B(1 To 1, 1 To 21), i, j, r, bol As Boolean
A = Sheets(2).UsedRange ...

基本已经达到要求了，就是表2中的F17没有取到，另外我想问下，如果日期取的是表2中的B6该怎么改，谢谢老师。

爱疯 · 发表于 2015-12-16 12:33

B(1, 19) = A(17, 5)
改为
B(1, 19) = A(17, 6)

爱疯 · 发表于 2015-12-16 12:37

取值3.rar (58.75 KB, 下载次数: 10)

teddyjin1984 · 发表于 2015-12-16 12:47

爱疯发表于 2015-12-16 12:37

Sub test3()
Dim A, B(1 To 1, 1 To 21), i, j, r, bol As Boolean
A = Sheets(2).UsedRange '填写表

For i = 8 To 15

      '1）先预览，如果该行有空值，就不添加
      bol = True
      If A(i, 2) = "" Or A(i, 4) = "" Or A(i, 6) = "" Or _
         A(i, 7) = "" Or A(i, 8) = "" Or A(i, 9) = "" Or _
         A(i, 10) = "" Or A(8, 11) = "" Then bol = False: Exit For

      '2）数据齐全，才添加
      If bol Then
         B(1, 1) = VBA.Split(A(6, 2), ".")(1)
         B(1, 2) = VBA.Split(A(6, 2), ".")(2)
         B(1, 3) = A(5, 5)
         B(1, 4) = A(2, 5)
         B(1, 5) = A(6, 10)

         B(1, 6) = A(23, 7)
         B(1, 7) = ""
         B(1, 8) = A(i, 2)
         B(1, 9) = A(i, 4) & "/" & A(i, 6)
         B(1, 10) = A(i, 8)

         B(1, 11) = A(i, 7)
         B(1, 12) = ""
         B(1, 13) = ""
         B(1, 14) = ""
         B(1, 15) = ""

         B(1, 16) = ""
         B(1, 17) = ""
         B(1, 18) = A(17, 2)
         B(1, 19) = A(17, 6)
         B(1, 20) = A(17, 9)
         B(1, 21) = ""

         With Sheets(1)
            r = .Cells(Rows.Count, "B").End(3).Row '数据表最后一行
            .Rows(r + 1 & ":" & Rows.Count).ClearContents
            .Cells(r + 1, 1).Resize(1, UBound(B, 2)) = B
         End With
      End If

Next i

End Sub

B(1, 4) = A(2, 5)  这条应该是B(1,4)=A(5,2)
我自己改了
可以了，谢谢老师！

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