如何根据原始表单元格A1的值将A列相同的固定区域自动调用相应区域数据

yzyyyyyyy

原始表中A1的值可选择

根据选择的值，将A列相等对应区域，写入固定区域 如何根据原始表单元格A1的值将A列相同的固定区域自动调用相应区域数据.rar (2.42 KB, 下载次数: 6)

2024-11-6 19:11 上传

点击文件名下载附件

shiruiqiang

判断，选择该单元格的resize(3,16).copy

shiruiqiang

yzyyyyyyy

1. Sub FindValueInRange()
   
2.     Dim ws As Worksheet
   
3.     Set ws = ThisWorkbook.Sheets("原始表") ' 修改为你的工作表名称
   
4.     Dim searchRange As Range
   
5.     Set searchRange = ws.Range("A20:A100") ' 修改为你要搜索的区域
   
6.     Dim searchValue As String
   
7.     searchValue = ws.[A1].Value ' 修改为你要查找的值
   
8.     Dim foundCell As Range
   
9.     Set foundCell = searchRange.Find(What:=searchValue, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
   
10.     If Not foundCell Is Nothing Then
    
11.        ' MsgBox "值找到在: " & foundCell.Address
    
12.         ws.[B2:P3].Value = foundCell.Offset(1, 1).Resize(2, 15).Value
    
13.     Else
    
14.         MsgBox "未找到值。"
    
15.     End If
    
16. End Sub

复制代码

gwjkkkkk

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim strTar$, tarRng As Range, ar(), n&
   
    If Target.Address <> "$A$1" Then Exit Sub
   
    strTar = [A1].Value
    n = Cells(Rows.Count, "A").End(xlUp).Row
    For i = 20 To n Step 6
        If Cells(i, 1).Value = strTar Then
            Application.EnableEvents = False
            Cells(i, 1).CurrentRegion.Copy
            [A1].PasteSpecial Paste:=xlPasteValues
            Application.EnableEvents = True
            Application.CutCopyMode = False
        End If
    Next i
End Sub

gwjkkkkk

参与一下。。。

chxw68

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2.     If Target.Count > 1 Then
   
3.         Exit Sub
   
4.     End If
   
5.     If Target.Address = "$A$1" Then
   
6.         Set Rng = Columns(1).Find(what:=Target.Value, LookIn:=xlValues, lookat:=xlWhole, searchorder:=xlByRows, searchdirection:=xlPrevious)
   
7.         If Not Rng Is Nothing Then
   
8.             If Rng.Address <> "$A$1" Then
   
9.                 Range("a1:p3").Copy Rng
   
10.             End If
    
11.         End If
    
12.     End If
    
13. 
    
14. End Sub
    

复制代码

chxw68

理解不一定正确。