excel - 使用带有条件的VBA将值从一张纸复制到另一张纸
问题描述
我的sheet_one
样子是这样的:
2019-12-31
A 2
B 3
C 10
我的sheet_two
样子是这样的:
2019-12-31 2020-01-31 2020-02-29 2020-03-31 2020-04-30 2020-05-31 2020-06-30 2020-07-31 2020-08-31 2020-09-30 2020-10-31 2020-11-30 2020-12-31
A
B
C
我的目标是将值从日期匹配的位置复制sheet_one
到如下所示:sheet_two
sheet_two
2019-12-31 2020-01-31 2020-02-29 2020-03-31 2020-04-30 2020-05-31 2020-06-30 2020-07-31 2020-08-31 2020-09-30 2020-10-31 2020-11-30 2020-12-31
A 2
B 3
C 10
在我将日期更改sheet_one
为假设2020-02-29
并运行具有相同值sheet_one
但更改日期的脚本后,sheet_two
它将如下所示:
2019-12-31 2020-01-31 2020-02-29 2020-03-31 2020-04-30 2020-05-31 2020-06-30 2020-07-31 2020-08-31 2020-09-30 2020-10-31 2020-11-30 2020-12-31
A 2 2
B 3 3
C 10 10
我试过的:
Sub test()
Dim rngDate As Range, rngLetter As Range
Dim dDate As Date
Dim LastRow As Long, LastColumn As Long, i As Long, y As Long
Dim Letter As String, strValue As String
With ThisWorkbook.Worksheets("Sheet1")
'Let as assume that Column A includes the letters. Find LastRow
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
'Let as assume that Row 1 includes the Dates. Find LastColumn
LastColumn = .Cells(1, .Columns.Count).End(xlToLeft).Column
'Test if there available Dates
If LastColumn > 1 Then
'Test if there available Letters
If LastRow > 1 Then
'Loop Dates
For i = 2 To LastColumn
'Set dDate
dDate = .Cells(1, i).Value
'Loop Letters
For y = 2 To LastRow
'Set Letter
Letter = .Cells(y, 1).Value
'Set Value to import
strValue = .Cells(y, i).Value
'Search in Sheet2
With ThisWorkbook.Worksheets("Sheet2")
'Let as assume that Row 1 includes the Dates
'Search for the dDate in Row 1
Set rngDate = .Rows(1).Find(What:=dDate, LookIn:=xlValues, lookat:=xlPart)
'Check if date found
If Not rngDate Is Nothing Then
'Search for the Letter in Column A
Set rngLetter = .Columns(1).Find(What:=Letter, LookIn:=xlValues, lookat:=xlPart)
If Not rngDate Is Nothing Then
'Import Value
.Cells(rngLetter.Row, rngDate.Column).Value = strValue
Else
MsgBox "Letter not found"
End If
Else
MsgBox "Date not found"
End If
End With
Next y
Next i
End If
End If
End With
但我得到:
MsgBox "找不到日期"
我的错误在哪里,或者这个问题有更好的解决方案吗?
谢谢你的建议。
解决方案
例如:您在 sheet1 中的数据作为@Naresh Bhople 的图像
在 sheet2: your header range = B1: H1, 然后可以使用这个代码
Sub Test()
Dim Rng_Header As Range: Set Rng_Header = Sheets("sheet2").[B1:H1]
Dim Ws1 As Worksheet: Set Ws1 = Sheets("Sheet1")
Dim index_column As Variant
index_column = Application.Match(Ws1.[B1], Rng_Header, 0) 'find index column in Rng_Header
If IsError(index_column) Then MsgBox ("does not exist date"): Exit Sub
''find rng_data then set ít value
Rng_Header.Offset(1, index_column - 1).Resize(3, 1).Value2 = Ws1.[B2:B4].Value2
End Sub
推荐阅读
- unity3d - 有没有办法在着色器中合并 Unity 中的纹理?
- visual-studio-code - 如何在 VS Code 中切换环境
- ruby-on-rails - 使用 mail_form freeze 发送电子邮件,没有错误 rails
- r - 在函数内,如果找不到 xpath,则返回 NA 或 0
- python - 如何在普通图像上粘贴半透明图像并获得透明度 PIL?
- composer-php - 在 laravel 8 中安装氩仪表板时找不到类“Laravel\Ui\UiCommand”
- windows-10 - Windows 10 搜索不包括带点名称的文件夹?
- c++ - 从可执行文件中删除调试“标志”的 C++ 方法
- html - 引导轮播不工作或滑动
- reactjs - 如何在 ReactHooks 中使用 useRef 使子菜单的每一项都会独立改变背景