セル結合して探せないはずのセルを検索してもエラーにはならない。

Sub test()

Dim str0 As String


Dim str1 As String
Dim str2 As String
Dim str3 As String

Dim i As Long
Dim j As Long

Dim wb1 As Workbook
Dim lastcol1 As Long
Dim lastcol2 As Long
Dim rng As Range

str1 = ThisWorkbook.Worksheets(1).Cells(1, 1)

'MsgBox str1

Set wb1 = Workbooks.Open(Filename:="C:\Users\yuba\Documents\vba\進捗表.xlsx")

lastcol1 = wb1.Worksheets(1).Cells(1, Columns.Count).End(xlToLeft).Column
lastcol2 = wb1.Worksheets(1).Cells(2, Columns.Count).End(xlToLeft).Column


'MsgBox "lastcol1= " & lastcol1 & " lastcol2 = " & lastcol2


For i = 1 To lastcol1

'MsgBox wb1.Worksheets(1).Cells(1, i).Value


If wb1.Worksheets(1).Cells(1, i).Value = str1 Then

' MsgBox "見つかった!"

ThisWorkbook.Worksheets(1).Cells(2, 1) = wb1.Worksheets(1).Cells(3, i).Value

Exit For

Else

' MsgBox wb1.Worksheets(1).Cells(1, i).Value & "なので一致しない"


End If

Next i





For j = 1 To lastcol2


'MsgBox wb1.Worksheets(1).Cells(2, j).Value



If wb1.Worksheets(1).Cells(2, j).Value = str1 Then


' MsgBox "見つかった!"

ThisWorkbook.Worksheets(1).Cells(2, 1) = wb1.Worksheets(1).Cells(3, j).Value

Exit For

Else

' MsgBox wb1.Worksheets(1).Cells(2, i).Value & "なので一致しない"



End If

Next j




' For Each rng In ActiveSheet.UsedRange
' If rng.MergeCells Then
' With rng.MergeArea
' .UnMerge
' .Value = .Resize(1, 1).Value
' End With
' End If
' Next


'lastcol1 = Cells(1, Columns.Count).End(xlToLeft).Column
'lastcol2 = Cells(2, Columns.Count).End(xlToLeft).Column
'
'
'MsgBox "lastcol1= " & lastcol1 & " lastcol2 = " & lastcol2



'LastRow1 = wb1.Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row
'LastRow2 = wb1.Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row


'Cells(1, Columns.Count).End(xlToLeft).Column


wb1.Close



End Sub

ブログ気持玉

クリックして気持ちを伝えよう!

ログインしてクリックすれば、自分のブログへのリンクが付きます。

→ログインへ

なるほど(納得、参考になった、ヘー)
驚いた
面白い
ナイス
ガッツ(がんばれ!)
かわいい

気持玉数 : 0

この記事へのコメント