答：
Sub?Demo()Dim?CurRng?As?Range
Dim?DesRng?As?Range
Dim?ExtRng?As?Range
Dim?Cell?As?Range
Dim?Cnt?As?Integer,?i?As?Integer,?j?As?Integer
Dim?TempStr?As?String
Set?CurRng?=?Range("A2")
Set?DesRng?=?Sheets("Sheet2").Range("C2")
Do?Until?CurRng.Row?=?Rows.Count
If?CurRng.End(xlDown).Row?=?Rows.Count?Then
Set?ExtRng?=?Range(CurRng,?Cells(Rows.Count,?"G").End(xlUp).Offset(0,?-6))
Else
Set?ExtRng?=?Range(CurRng,?CurRng.End(xlDown).Offset(-1,?0))
End?If
For?i?=?1?To?2
If?i?=?1?Then
Set?ExtRng?=?ExtRng.Offset(0,?4)
Else
Set?ExtRng?=?ExtRng.Offset(0,?2)
End?If
Cnt?=?Application.CountA(ExtRng)
For?Each?Cell?In?ExtRng
If?Not?IsEmpty(Cell)?Then
TempStr?=?TempStr?&?"i:"?&?j?&?";s:"?&?Len(Cell)?&?":"?&?""""""?&?Cell?&?""""""?&?";"
End?If
j?=?j?+?1
Next
With?DesRng
.Offset(0,?3)?=?"a:"?&?Cnt?&?":{"?&?TempStr?&?"}"
.Offset(0,?0)?=?CurRng.Offset(0,?i)
.Offset(0,?4)?=?CurRng
.Offset(0,?5)?=?i?-?1
End?With
TempStr?=?"":?Cnt?=?0:?j?=?0
Set?DesRng?=?DesRng.Offset(1,?0)
Next
Set?CurRng?=?CurRng.End(xlDown)
Loop
End?Sub